Toggle diff (480 lines)
diff --git a/Makefile.am b/Makefile.am
index f6fae09579..b9265c154d 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -261,6 +261,7 @@ MODULES = \
guix/import/json.scm \
guix/import/kde.scm \
guix/import/launchpad.scm \
+ guix/import/contentdb.scm \
guix/import/opam.scm \
guix/import/print.scm \
guix/import/pypi.scm \
@@ -303,6 +304,7 @@ MODULES = \
guix/scripts/import/go.scm \
guix/scripts/import/hackage.scm \
guix/scripts/import/json.scm \
+ guix/scripts/import/contentdb.scm \
guix/scripts/import/opam.scm \
guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm \
@@ -445,6 +447,7 @@ SCM_TESTS = \
tests/channels.scm \
tests/combinators.scm \
tests/containers.scm \
+ tests/contentdb.scm \
tests/cpan.scm \
tests/cpio.scm \
tests/cran.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 43c248234d..d06c9b73c5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11313,6 +11313,31 @@ and generate package expressions for all those packages that are not yet
in Guix.
@end table
+@item contentdb
+@cindex ContentDB
+Import metadata from @uref{https://content.minetest.net, ContentDB}.
+Information is taken from the JSON-formatted metadata provided through
+@uref{https://content.minetest.net/help/api/, ContentDB's API} and
+includes most relevant information, including dependencies. There are
+some caveats, however. The license information on ContentDB does not
+distinguish between GPLvN-only and GPLvN-or-later. The commit id is
+sometimes missing. The descriptions are in the Markdown format, but
+Guix uses Texinfo instead. Texture packs and subgames are unsupported.
+
+The command below imports metadata for the Mesecons mod by Jeija:
+
+@example
+guix import contentdb Jeija mesecons
+@end example
+
+@table @code
+@item --recursive
+@itemx -r
+Traverse the dependency graph of the given upstream package recursively
+and generate package expressions for all those packages that are not yet
+in Guix.
+@end table
+
@item cpan
@cindex CPAN
Import metadata from @uref{https://www.metacpan.org/, MetaCPAN}.
diff --git a/guix/import/contentdb.scm b/guix/import/contentdb.scm
new file mode 100644
index 0000000000..1a36a09c92
--- /dev/null
+++ b/guix/import/contentdb.scm
@@ -0,0 +1,310 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet;be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import contentdb)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (guix utils)
+ #:use-module (guix memoization)
+ #:use-module (guix serialization)
+ #:use-module (guix import utils)
+ #:use-module (guix import json)
+ #:use-module ((gcrypt hash) #:select (open-sha256-port port-sha256))
+ #:use-module (json)
+ #:use-module (guix base32)
+ #:use-module (guix git)
+ #:use-module (guix store)
+ #:use-module ((guix licenses) #:prefix license:)
+ #:export (%contentdb-api
+ contentdb->guix-package
+ contentdb-recursive-import))
+
+;; The ContentDB API is documented at
+;; <https://content.minetest.net>.
+
+(define %contentdb-api
+ (make-parameter "https://content.minetest.net/api/"))
+
+(define (string-or-false x)
+ (and (string? x) x))
+
+(define (natural-or-false x)
+ (and (exact-integer? x) (>= x 0) x))
+
+;; Descriptions on ContentDB use carriage returns, but Guix doesn't.
+(define (delete-cr text)
+ (string-delete #\cr text))
+
+;; Minetest package.
+;;
+;; API endpoint: /packages/AUTHOR/NAME/
+(define-json-mapping <package> make-package package?
+ json->package
+ (author package-author) ; string
+ (creation-date package-creation-date ; string
+ "created_at")
+ (downloads package-downloads) ; integer
+ (forums package-forums "forums" natural-or-false) ; natural | #f
+ (issue-tracker package-issue-tracker "issue_tracker") ; string
+ (license package-license) ; string
+ (long-description package-long-description "long_description") ; string
+ (maintainers package-maintainers ; list of strings
+ "maintainers" vector->list)
+ (media-license package-media-license "media_license") ; string
+ (name package-name) ; string
+ (provides package-provides ; list of strings
+ "provides" vector->list)
+ (release package-release) ; integer
+ (repository package-repository "repo" string-or-false) ; string | #f
+ (score package-score) ; flonum
+ (screenshots package-screenshots "screenshots" vector->list) ; list of strings
+ (short-description package-short-description "short_description") ; string
+ (state package-state) ; string
+ (tags package-tags "tags" vector->list) ; list of strings
+ (thumbnail package-thumbnail) ; string
+ (title package-title) ; string
+ (type package-type) ; string
+ (url package-url) ; string
+ (website package-website "website" string-or-false)) ; string | #f
+
+(define-json-mapping <release> make-release release?
+ json->release
+ (commit release-commit "commit" string-or-false) ; string | #f
+ (downloads release-downloads) ; integer
+ (id release-id) ; integer
+ (max-minetest-version release-max-minetest-version) ; string | #f
+ (min-minetest-version release-min-minetest-version) ; string | #f
+ (release-date release-data) ; string
+ (title release-title) ; string
+ (url release-url)) ; string
+
+(define-json-mapping <dependency> make-dependency dependency?
+ json->dependency
+ (optional? dependency-optional? "is_optional") ; #t | #f
+ (name dependency-name) ; string
+ (packages dependency-packages "packages" vector->list)) ; list of strings
+
+(define (contentdb-fetch author name)
+ "Return a <package> record for package NAME by AUTHOR, or #f on failure."
+ (and=> (json-fetch
+ (string-append (%contentdb-api) "packages/" author "/" name "/"))
+ json->package))
+
+(define (contentdb-fetch-releases author name)
+ "Return a list of <release> records for package NAME by AUTHOR, or #f
+on failure."
+ (and=> (json-fetch (string-append (%contentdb-api) "packages/" author "/" name
+ "/releases/"))
+ (lambda (json)
+ (map json->release (vector->list json)))))
+
+(define (latest-release author name)
+ "Return the latest source release for package NAME by AUTHOR,
+or #f if this package does not exist."
+ (and=> (contentdb-fetch-releases author name)
+ car))
+
+(define (contentdb-fetch-dependencies author name)
+ "Return an alist of lists of <dependency> records for package NAME by AUTHOR
+and possibly some other packages as well, or #f on failure."
+ (define url (string-append (%contentdb-api) "packages/" author "/" name
+ "/dependencies/"))
+ (and=> (json-fetch url)
+ (lambda (json)
+ (map (match-lambda
+ ((key . value)
+ (cons key (map json->dependency (vector->list value)))))
+ json))))
+
+(define (contentdb->package-name name)
+ "Given the NAME of a package on ContentDB, return a Guix-compliant name for the
+package."
+ ;; The author is not included, as the names of popular mods
+ ;; tend to be unique.
+ (string-append "minetest-" (snake-case name)))
+
+;; XXX copied from (guix import elpa)
+(define* (download-git-repository url ref)
+ "Fetch the given REF from the Git repository at URL."
+ (with-store store
+ (latest-repository-commit store url #:ref ref)))
+
+;; XXX adapted from (guix scripts hash)
+(define (file-hash file select? recursive?)
+ ;; Compute the hash of FILE.
+ (if recursive?
+ (let-values (((port get-hash) (open-sha256-port)))
+ (write-file file port #:select? select?)
+ (force-output port)
+ (get-hash))
+ (call-with-input-file file port-sha256)))
+;; XXX likewise.
+(define (vcs-file? file stat)
+ (case (stat:type stat)
+ ((directory)
+ (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+ ((regular)
+ ;; Git sub-modules have a '.git' file that is a regular text file.
+ (string=? (basename file) ".git"))
+ (else
+ #f)))
+
+(define (make-minetest-sexp name version repository commit
+ inputs home-page synopsis
+ description media-license license)
+ "Return a S-expression for the minetest package with the given NAME,
+VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
+MEDIA-LICENSE and LICENSE."
+ `(package
+ (name ,(contentdb->package-name name))
+ (version ,version)
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,repository)
+ (commit ,commit)))
+ (sha256
+ (base32
+ ;; The commit id is not always available.
+ ,(and commit
+ (bytevector->nix-base32-string
+ (file-hash
+ (download-git-repository repository `(commit . ,commit))
+ (negate vcs-file?) #t)))))
+ (file-name (git-file-name name version))))
+ (build-system minetest-mod-build-system)
+ ,@(maybe-propagated-inputs
+ (map (compose contentdb->package-name cdr) inputs))
+ (home-page ,home-page)
+ (synopsis ,(delete-cr synopsis))
+ (description ,(delete-cr description))
+ (license ,(if (eq? media-license license)
+ (license->symbol license)
+ `(list ,(license->symbol media-license)
+ ,(license->symbol license))))))
+
+(define (package-home-page package)
+ "Guess the home page of the ContentDB package PACKAGE.
+
+In order of preference, try the 'website', the forum topic on the
+official Minetest forum and the Git repository (if any)."
+ (define (topic->url-sexp topic)
+ ;; 'minetest-topic' is a procedure defined in (gnu packages minetest)
+ `(minetest-topic ,topic))
+ (or (package-website package)
+ (and=> (package-forums package) topic->url-sexp)
+ (package-repository package)))
+
+(define (important-dependencies dependencies author name)
+ (define dependency-list
+ (assoc-ref dependencies (string-append author "/" name)))
+ (filter-map
+ (lambda (dependency)
+ (and (not (dependency-optional? dependency))
+ ;; "default" must be provided by the 'subgame' in use
+ ;; and does not refer to a specific minetest mod.
+ ;; "doors", "bucket" ... are provided by the default minetest
+ ;; subgame.
+ (not (member (dependency-name dependency)
+ '("default" "doors" "beds" "bucket" "doors" "farming"
+ "flowers" "stairs" "xpanes")))
+ ;; Dependencies often have only one implementation.
+ (let* ((/name (string-append "/" (dependency-name dependency)))
+ (likewise-named-implementations
+ (filter (cut string-suffix? /name <>)
+ (dependency-packages dependency)))
+ (implementation
+ (and (not (null? likewise-named-implementations))
+ (first likewise-named-implementations))))
+ (and implementation
+ (apply cons (string-split implementation #\/))))))
+ dependency-list))
+
+(define* (%contentdb->guix-package author name)
+ "Fetch the metadata for NAME by AUTHOR from https://content.minetest.net, and
+return the 'package' S-expression corresponding to that package, or #f on failure.
+On success, also return the upstream dependencies as a list of
+(AUTHOR . NAME) pairs."
+ (and-let* ((package (contentdb-fetch author name))
+ (dependencies (contentdb-fetch-dependencies author name))
+ (release (latest-release author name)))
+ (let ((important-upstream-dependencies
+ (important-dependencies dependencies author name)))
+ (values (make-minetest-sexp name
+ (release-title release) ; version
+ (package-repository package)
+ (release-commit release)
+ important-upstream-dependencies
+ (package-home-page package)
+ (package-short-description package)
+ (package-long-description package)
+ (string->license
+ (package-media-license package))
+ (string->license
+ (package-license package)))
+ important-upstream-dependencies))))
+
+(define contentdb->guix-package
+ (memoize %contentdb->guix-package))
+
+(define (contentdb-recursive-import author name)
+ ;; recursive-import expects upstream package names to be strings,
+ ;; so do some conversions.
+ (define (split-author/name author/name)
+ (string-split author/name #\/))
+ (define (author+name->author/name author+name)
+ (string-append (car author+name) "/" (cdr author+name)))
+ (define* (contentdb->guix-package* author/name #:key repo version)
+ (receive (package . maybe-dependencies)
+ (apply contentdb->guix-package (split-author/name author/name))
+ (and package
+ (receive (dependencies)
+ (apply values maybe-dependencies)
+ (values package
+ (map author+name->author/name dependencies))))))
+ (recursive-import (author+name->author/name (cons author name))
+ #:repo->guix-package contentdb->guix-package*
+ #:guix-name
+ (lambda (author/name)
+ (contentdb->package-name
+ (second (split-author/name author/name))))))
+
+;; A list of license names is available at
+;; <https://content.minetest.net/api/licenses/>.
+(define (string->license str)
+ "Convert the string STR into a license object."
+ (match str
+ ("GPLv3" license:gpl3)
+ ("GPLv2" license:gpl2)
+ ("ISC" license:isc)
+ ;; "MIT" means the Expat license on ContentDB,
+ ;; see <https://github.com/minetest/contentdb/issues/326#issuecomment-890143784>.
+ ("MIT" license:expat)
+ ("CC BY-SA 3.0" license:cc-by-sa3.0)
+ ("CC BY-SA 4.0" license:cc-by-sa4.0)
+ ("LGPLv2.1" license:lgpl2.1)
+ ("LGPLv3" license:lgpl3)
+ ("MPL 2.0" license:mpl2.0)
+ ("ZLib" license:zlib)
+ ("Unlicense" license:unlicense)
+ (_ #f)))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index f53d1ac1f4..015677e719 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -77,7 +77,8 @@ rather than \\n."
;;;
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
- "gem" "go" "cran" "crate" "texlive" "json" "opam"))
+ "gem" "go" "cran" "crate" "texlive" "json" "opam"
+ "contentdb"))
(define (resolve-importer name)
(let ((module (resolve-interface
diff --git a/guix/scripts/import/contentdb.scm b/guix/scripts/import/contentdb.scm
new file mode 100644
index 0000000000..4170fff950
--- /dev/null
+++ b/guix/scripts/import/contentdb.scm
@@ -0,0 +1,106 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import contentdb)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts)
+ #:use-module (guix import contentdb)
+ #:use-module (guix import utils)
+ #:use-module (guix scripts import)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:export (guix-import-contentdb))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ '())
+
+(define (show-help)
+ (display (G_ "Usage: guix import contentdb AUTHOR NAME
+Import and convert the Minetest mod NAME by AUTHOR from ContentDB.\n"))
+ (display (G_ "
+ -h, --help display this help and exit"))
+ (display (G_ "
+ -r, --recursive import packages recursively"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specification of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix import contentdb")))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
+ %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-contentdb . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (G_ "~A: unrecognized option~%") name))
+ (lambda (arg r
