(address . guix-patches@gnu.org)(name . Antero Mejr)(address . antero@mailbox.org)
20230304041458.32761-1-antero@mailbox.org
* guix/lint.scm (check-copyleft, input->package, report-copyleft-violation,
linking-exception?, copyleft?): New procedures.
(%local-checkers): Add 'copyleft' checker.
* tests/lint.scm ("copyleft: incompatible copyleft input"): New tests.
* doc/guix.texi (Invoking guix lint): Mention it.
---
This new linter checks for copyleft license violations, where a copylefted
package is linked by a package with an incompatible license.
It found 2818 incompatible packages.
For example, GNU readline (GPL) is being linked by 71 permissively
licensed packages.
doc/guix.texi | 4 ++
guix/lint.scm | 109 +++++++++++++++++++++++++++++++++++++++++++++++++
tests/lint.scm | 10 +++++
3 files changed, 123 insertions(+)
Toggle diff (200 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 74658dbc86..be695967a2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14723,6 +14723,10 @@ corresponding package. This aims to help migrate from the ``old input
style''. @xref{package Reference}, for more information on package
inputs and input styles. @xref{Invoking guix style}, on how to migrate
to the new style.
+
+@item copyleft
+Warn about packages with permissive licenses that are not compatible with
+the copyleft licenses of their dependencies.
@end table
The general syntax is:
diff --git a/guix/lint.scm b/guix/lint.scm
index 8e3976171f..30745b0930 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -40,6 +40,7 @@ (define-module (guix lint)
#:use-module (guix download)
#:use-module (guix ftp-client)
#:use-module (guix http-client)
+ #:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (guix i18n)
#:use-module ((guix gexp)
@@ -108,6 +109,7 @@ (define-module (guix lint)
check-mirror-url
check-github-url
check-license
+ check-copyleft
check-vulnerabilities
check-for-updates
check-formatting
@@ -1451,6 +1453,12 @@ (define format
(with-store store
(do-check store))))
+
+
+;;;
+;;; Package licenses.
+;;;
+
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."
(match (package-license package)
@@ -1462,6 +1470,103 @@ (define (check-license package)
(make-warning package (G_ "invalid license field")
#:field 'license)))))
+(define (copyleft? licenses)
+ "Check if a list of licenses are copyleft."
+ (let ((lic (if (list? licenses) licenses (list licenses))))
+ (map (lambda (x)
+ (and (license? x) ;some license fields are not license objects
+ (member (license-name x)
+ '("AGPL 1" "AGPL 3" "AGPL 3+"
+ "CC-BY-SA 2.0" "CC-BY-SA 3.0" "CC-BY-SA 4.0"
+ "CeCILL" "copyleft-next"
+ "EUPL 1.1" "EUPL 1.2"
+ "GPL 1" "GPL 1+" "GPL 2" "GPL 2+" "GPL 3" "GPL 3+"
+ "Sleepycat"))
+ #t))
+ lic)))
+
+(define (linking-exception? package)
+ "Check if a package has a known copyleft linking exception or is not linked."
+ (and (member (package-name package)
+ '(;; linking exception
+ "classpath" "guile" "java-classpathx-servletapi" "icedtea"
+ "uwsgi"
+ ;; copyleft but not typically linked
+ "alsa-utils" "acpi" "acpica" "audit"
+ "bash" "bash-completion" "bash-minimal" "bash-static" "bc"
+ "bluez" "binutils" "bison" "btrfs-progs"
+ "catdoc" "cdparanoia" "colord" "colord-minimal" "coreutils"
+ "coreutils-minimal" "cpuid" "cpupower" "cryptsetup"
+ "dbus" "dbus-glib" "diffutils" "dmidecode" "dmraid" "dnsmasq"
+ "dosfstools" "dpkg"
+ "ebtables" "edac-utils" "egawk-next" "efibootmgr" "espeak"
+ "espeak-ng" "ethtool" "eudev"
+ "fcitx" "ffmpeg" "findutils" "fontforge"
+ "gawk" "gawk-mpfr" "geoclue" "gettext" "gettext-minimal"
+ "ghostscript" "git" "git-minimal" "gjs" "gnupg" "gnome-desktop"
+ "gpart" "gperf" "gpm" "grep" "groff" "gzip"
+ "hddtemp" "hwinfo" "kbd" "kexec-tools" "kmod"
+ "less" "lm-sensors" "lzip"
+ "i2c-tools" "inetutils" "inxi" "inxi-minimal" "iproute2"
+ "iptables" "iso-codes"
+ "m4" "make" "mariadb" "mawk" "mcelog" "mdadm" "memtester"
+ "miscfiles" "modem-manager" "module-init-tools" "mpv" "mysql"
+ "ndctl" "net-tools" "netcat" "nvme-cli"
+ "pandoc" "parted" "password-store" "pciutils" "perl"
+ "pkg-config" "postgresql" "procps" "psmisc" "pulseaudio"
+ "qemu" "qemu-minimal" "ragel" "rpm" "rsync"
+ "samba" "sane-backends" "sbc" "scummvm" "sed"
+ "shared-mime-info" "shepherd" "smartmontools" "socat"
+ "squashfs-tools" "sysstat"
+ "tar" "time" "torsocks"
+ "upower" "usbutils" "util-linux"
+ "valgrind" "vidstab" "volume-key"
+ "wget" "which" "wl-clipboard" "yelp" "xclip"
+ "linux-libre-headers" "gnumach-headers" "hurd-headers"
+ "gcc" "gcc-toolchain" "gfortran" "clang-toolchain"
+ "ld-wrapper" "ld.lld-wrapper" "lld-wrapper"))
+ #t))
+
+(define (report-copyleft-violation package input-name)
+ "Report information about a copyleft license violation."
+ (make-warning package
+ (G_ "The license of input ~a is copyleft, but the license \
+of package ~a is permissive.")
+ (list input-name (package-name package))
+ #:field 'license))
+
+(define (input->package input)
+ "Convert a package input into a package if possible."
+ (if (list? input)
+ (cadr input)
+ #f))
+
+(define (check-copyleft package)
+ "Check that PACKAGE does not violate copyleft licenses of its inputs."
+ ;; Assumes all copyleft licenses are compatible, which is true for now
+ (let* ((pkg-copyleft (member #t (copyleft? (package-license package)))))
+ (apply append
+ (map (lambda (input)
+ (let ((input-copyleft
+ ;; if any license is permissive, the input is.
+ ;; be lenient here to avoid false positives
+ (not (member #f (copyleft? (package-license input))))))
+ (if (and input-copyleft
+ (not pkg-copyleft)
+ (not (linking-exception? input)))
+ (list (report-copyleft-violation package
+ (package-name input)))
+ '())))
+ (filter package?
+ (map input->package
+ (append (package-inputs package)
+ (package-propagated-inputs package))))))))
+
+
+;;;
+;;; Vulnerabilities and updates.
+;;;
+
(define (current-vulnerabilities*)
"Like 'current-vulnerabilities', but return the empty list upon networking
or HTTP errors. This allows network-less operation and makes problems with
@@ -1885,6 +1990,10 @@ (define %local-checkers
(description "Make sure the 'license' field is a <license> \
or a list thereof")
(check check-license))
+ (lint-checker
+ (name 'copyleft)
+ (description "Check for copyleft license violations")
+ (check check-copyleft))
(lint-checker
(name 'optional-tests)
(description "Make sure tests are only run when requested")
diff --git a/tests/lint.scm b/tests/lint.scm
index ce22e2355a..1ae64510b6 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -40,6 +40,7 @@ (define-module (test-lint)
#:use-module (guix build-system emacs)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
+ #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix lint)
#:use-module (guix ui)
#:use-module (guix swh)
@@ -51,6 +52,7 @@ (define-module (test-lint)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python-build)
+ #:use-module (gnu packages readline)
#:use-module ((gnu packages bash) #:select (bash bash-minimal))
#:use-module (web uri)
#:use-module (web server)
@@ -665,6 +667,14 @@ (define hsab (string-append (assoc-ref inputs "hsab")
(single-lint-warning-message
(check-license (dummy-package "x" (license #f)))))
+(test-equal "copyleft: incompatible copyleft input"
+ "The license of input readline is copyleft, but the license of package x is permissive."
+ (single-lint-warning-message
+ (check-copyleft
+ (dummy-package "x"
+ (inputs `(("readline" ,readline)))
+ (license license:bsd-3)))))
+
(test-equal "home-page: wrong home-page"
"invalid value for home page"
(let ((pkg (package
--
2.38.1