diff mbox series

[bug#49828,06/20] guix: Add ContentDB importer.

Message ID 20210802155019.6122-6-maximedevos@telenet.be
State Accepted
Headers show
Series Add minetest mods | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

M Aug. 2, 2021, 3:50 p.m. UTC
* guix/import/contentdb.scm: New file.
* guix/scripts/import/contentdb.scm: New file.
* tests/contentdb.scm: New file.
* Makefile.am (MODULES, SCM_TESTS): Register them.
* po/guix/POTFILES.in: Likewise.
* doc/guix.texi (Invoking guix import): Document it.
---
 Makefile.am                       |   3 +
 doc/guix.texi                     |  25 +++
 guix/import/contentdb.scm         | 310 ++++++++++++++++++++++++++++++
 guix/scripts/import.scm           |   3 +-
 guix/scripts/import/contentdb.scm | 106 ++++++++++
 po/guix/POTFILES.in               |   1 +
 tests/contentdb.scm               | 227 ++++++++++++++++++++++
 7 files changed, 674 insertions(+), 1 deletion(-)
 create mode 100644 guix/import/contentdb.scm
 create mode 100644 guix/scripts/import/contentdb.scm
 create mode 100644 tests/contentdb.scm

Comments

Leo Prikler Aug. 5, 2021, 4:41 p.m. UTC | #1
Hi,

Am Montag, den 02.08.2021, 17:50 +0200 schrieb Maxime Devos:
> * guix/import/contentdb.scm: New file.
> * guix/scripts/import/contentdb.scm: New file.
> * tests/contentdb.scm: New file.
> * Makefile.am (MODULES, SCM_TESTS): Register them.
> * po/guix/POTFILES.in: Likewise.
> * doc/guix.texi (Invoking guix import): Document it.
> [...]
> 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.
What is the "commit id"?  Is it the hash?  A tag?  Anything that
resolves to a commit?

Also, since ContentDB sounds fairly generic (a database of content?),
perhaps we ought to call this the "minetest" importer instead?

> [...]
> +;; 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
This comment and some others like it seem to simply be repeating
already present information.  Is there a use for them?  Should we
instead provide a third argument on every field to verify/enforce the
type?
> +  (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
Also known as "boolean".
> +  (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))
Is there a reason for author and name to be separate keys?  For me it
makes more sense to take AUTHOR/NAME as a singular search string from
users and then perform queries based on that.  If ContentDB allows
searching, we might also resolve NAME to a singular package where
possible and otherwise error out, telling the user to choose one.

> [...]
> +
> +(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))
What exactly does the likewise-named-implementations bit do here?

> +(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 #\/))
+1 for my author/name splitting, as it's already required for recursive
imports.
> +  (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)))
The link mentions, that ContentDB now supports all SPDX identifiers. 
Do we have a SPDX->Guix converter lying around in some other importer
that we could use as default case here (especially w.r.t. "or later")

WDYT?
diff mbox series

Patch

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 result)
+                  (alist-cons 'argument arg result))
+                %default-options))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                            (('argument . value)
+                             value)
+                            (_ #f))
+                           (reverse opts))))
+    (match args
+      ((author name)
+       (with-error-handling
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (filter-map package->definition
+                         (contentdb-recursive-import author name))
+             ;; Single import
+             (let ((sexp (contentdb->guix-package author name)))
+               (unless sexp
+                 (leave (G_ "failed to download meta-data for package '~a' by '~a'~%")
+                        name author))
+               sexp))))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index a3bced1a8f..f25a7b4802 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -60,6 +60,7 @@  guix/scripts/git.scm
 guix/scripts/git/authenticate.scm
 guix/scripts/hash.scm
 guix/scripts/import.scm
+guix/scripts/import/contentdb.scm
 guix/scripts/import/cran.scm
 guix/scripts/import/elpa.scm
 guix/scripts/pull.scm
diff --git a/tests/contentdb.scm b/tests/contentdb.scm
new file mode 100644
index 0000000000..1293ac40cf
--- /dev/null
+++ b/tests/contentdb.scm
@@ -0,0 +1,227 @@ 
+;;; 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 (test-contentdb)
+  #:use-module (guix memoization)
+  #:use-module (guix import contentdb)
+  #:use-module (guix import utils)
+  #:use-module (guix tests)
+  #:use-module (json)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+
+;; Some procedures for populating a ‘fake’ ContentDB server.
+
+(define* (make-package-sexp #:key
+                            (guix-name "minetest-foo")
+                            (home-page "https://example.org/foo")
+                            (repo "https://example.org/foo.git")
+                            (synopsis "synopsis")
+                            (guix-description "description")
+                            (guix-license '(list license:cc-by-sa4.0 license:lgpl3))
+                            (inputs '())
+                            #:allow-other-keys)
+  `(package
+     (name ,guix-name)
+     ;; This is not a proper version number but ContentDB does not include
+     ;; version numbers.
+     (version "2021-07-25")
+     (source
+      (origin
+        (method git-fetch)
+        (uri (git-reference
+              (url ,(and (not (eq? repo 'null)) repo))
+              (commit #f)))
+        (sha256
+         (base32 #f))
+        (file-name (git-file-name name version))))
+     (build-system minetest-mod-build-system)
+     ,@(maybe-propagated-inputs inputs)
+     (home-page ,home-page)
+     (synopsis ,synopsis)
+     (description ,guix-description)
+     (license ,guix-license)))
+
+(define* (make-package-json #:key
+                            (author "Author")
+                            (name "foo")
+                            (media-license "CC BY-SA 4.0")
+                            (license "LGPLv3")
+                            (short-description "synopsis")
+                            (long-description "description")
+                            (repo "https://example.org/foo.git")
+                            (website "https://example.org/foo")
+                            (forums 321)
+                            #:allow-other-keys)
+  `(("author" . ,author)
+    ("content_warnings" . #())
+    ("created_at" . "2018-05-23T19:58:07.422108")
+    ("downloads" . 123)
+    ("forums" . ,forums)
+    ("issue_tracker" . "https://example.org/foo/issues")
+    ("license" . ,license)
+    ("long_description" . ,long-description)
+    ("maintainers" . #("maintainer"))
+    ("media_license" . ,media-license)
+    ("name" . ,name)
+    ("provides" . #("stuff"))
+    ("release" . 456)
+    ("repo" . ,repo)
+    ("score" . ,987.654)
+    ("screenshots" . #())
+    ("short_description" . ,short-description)
+    ("state" . "APPROVED")
+    ("tags" . #("some" "tags"))
+    ("thumbnail" . null)
+    ("title" . "The name")
+    ("type" . "mod")
+    ("url" . ,(string-append "https://content.minetest.net/packages/"
+                             author "/" name "/download/"))
+    ("website" . ,website)))
+
+(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys)
+  `#((("commit" . ,commit)
+      ("downloads" . 469)
+      ("id" . 8614)
+      ("max_minetest_version" . null)
+      ("min_minetest_version" . null)
+      ("release_date" . "2021-07-25T01:10:23.207584")
+      ("title" . "2021-07-25"))))
+
+(define* (make-dependencies-json #:key (author "Author")
+                                 (name "foo")
+                                 (requirements '(("default" #f ())))
+                                 #:allow-other-keys)
+  `((,(string-append author "/" name)
+     . ,(list->vector
+         (map (match-lambda
+                ((symbolic-name optional? implementations)
+                 `(("is_optional" . ,optional?)
+                   ("name" . ,symbolic-name)
+                   ("packages" . ,(list->vector implementations)))))
+              requirements)))
+    ("something/else" . #())))
+
+(define (call-with-packages thunk . argument-lists)
+  (mock ((guix http-client) http-fetch
+         (lambda* (url #:key headers)
+           (unless (string-prefix? "mock://api/packages/" url)
+             (error "the URL ~a should not be used" url))
+           (define resource
+             (substring url (string-length "mock://api/packages/")))
+           (define components (string-split resource #\/))
+           (unless (>= (length components) 2)
+             (error "the URL ~a should have an author and name component" url))
+           (define requested-author (list-ref components 0))
+           (define requested-name (list-ref components 1))
+           (define rest (cddr components))
+           (define relevant-argument-list
+             (any (lambda (argument-list)
+                    (apply (lambda* (#:key (author "Author") (name "foo")
+                                     #:allow-other-keys)
+                             (and (equal? requested-author author)
+                                  (equal? requested-name name)
+                                  argument-list))
+                           argument-list))
+                  argument-lists))
+           (when (not relevant-argument-list)
+             (error "the package ~a/~a should be irrelevant, but ~a is fetched"
+                    requested-author requested-name url))
+           (define (scm->json-port scm)
+             (open-input-string (scm->json-string scm)))
+           (scm->json-port
+            (apply (match rest
+                     (("") make-package-json)
+                     (("dependencies" "") make-dependencies-json)
+                     (("releases" "") make-releases-json)
+                     (_ (error "TODO ~a" rest)))
+                   relevant-argument-list))))
+        (parameterize ((%contentdb-api "mock://api/"))
+          (thunk))))
+
+(define* (contentdb->guix-package* #:key (author "Author") (name "foo")
+                                   #:allow-other-keys)
+  (contentdb->guix-package author name))
+
+(define (imported-package-sexp . extra-arguments)
+  (call-with-packages
+   (lambda ()
+     ;; Don't reuse results from previous tests.
+     (invalidate-memoization! contentdb->guix-package)
+     (apply contentdb->guix-package* extra-arguments))
+   extra-arguments))
+
+(define-syntax-rule (test-package test-case . extra-arguments)
+  (test-equal test-case
+    (make-package-sexp . extra-arguments)
+    (imported-package-sexp . extra-arguments)))
+
+(test-begin "contentdb")
+
+
+;; Package names
+(test-package "contentdb->guix-package")
+(test-package "contentdb->guix-package, _ → - in package name"
+              #:name "foo_bar"
+              #:guix-name "minetest-foo-bar")
+
+
+;; Determining the home page
+(test-package "contentdb->guix-package, website is used as home page"
+              #:home-page "web://site"
+              #:website "web://site")
+(test-package "contentdb->guix-package, if absent, the forum is used"
+              #:home-page '(minetest-topic 628)
+              #:forums 628
+              #:website 'null)
+(test-package "contentdb->guix-package, if absent, the git repo is used"
+              #:home-page "https://github.com/minetest-mods/mesecons"
+              #:forums 'null
+              #:website 'null
+              #:repo "https://github.com/minetest-mods/mesecons")
+(test-package "contentdb->guix-package, all home page information absent"
+              #:home-page #f
+              #:forums 'null
+              #:website 'null
+              #:repo 'null)
+
+
+
+;; Dependencies
+(test-package "contentdb->guix-package, dependency"
+              #:requirements '(("mesecons" #f
+                                ("Jeija/mesecons"
+                                 "some-modpack/containing-mese")))
+              #:inputs '("minetest-mesecons"))
+
+(test-package "contentdb->guix-package, optional dependency"
+              #:requirements '(("mesecons" #t
+                                ("Jeija/mesecons"
+                                 "some-modpack/containing-mese")))
+              #:inputs '())
+
+
+;; License
+(test-package "contentdb->guix-package, identical licenses"
+              #:guix-license 'license:lgpl3
+              #:license "LGPLv3"
+              #:media-license "LGPLv3")
+
+(test-end "contentdb")