;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020-2024 Efraim Flashner ;;; Copyright © 2018, 2020 Tobias Geerinckx-Rice ;;; Copyright © 2020 Marius Bakke ;;; Copyright © 2023, 2024 Denis 'GNUtoo' Carikli ;;; ;;; 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 . (define-module (gnu packages debian) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix download) #:use-module (guix git-download) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix build-system cmake) #:use-module (guix build-system copy) #:use-module (guix build-system gnu) #:use-module (guix build-system perl) #:use-module (guix build-system trivial) #:use-module (gnu packages adns) #:use-module (gnu packages autotools) #:use-module (gnu packages backup) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages compression) #:use-module (gnu packages crypto) #:use-module (gnu packages databases) #:use-module (gnu packages dbm) #:use-module (gnu packages gettext) #:use-module (gnu packages gnupg) #:use-module (gnu packages guile) #:use-module (gnu packages libevent) #:use-module (gnu packages linux) #:use-module (gnu pac
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018, 2019 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 (gnu services authentication)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services dbus)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages openldap)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (fprintd-configuration
            fprintd-configuration?
            fprintd-service-type

            nslcd-configuration
            nslcd-configuration?
            nslcd-service-type))

(define-configuration fprintd-configuration
  (fprintd      (file-like fprintd)
                "The fprintd package"))

(define (fprintd-dbus-service config)
  (list (fprintd-configuration-fprintd config)))

(define fprintd-service-type
  (service-type (name 'fprintd)
                (extensions
                 (list (service-extension dbus-root-service-type
                                          fprintd-dbus-service)
                       (service-extension polkit-service-type
                                          fprintd-dbus-service)))
                (default-value (fprintd-configuration))
                (description
                 "Run fprintd, a fingerprint management daemon.")))


;;;
;;; NSS Pam LDAP service (nslcd)
;;;

(define (uglify-field-name name)
  (match name
    ('filters "filter")
    ('maps "map")
    (_ (string-map (match-lambda
                     (#\- #\_)
                     (chr chr))
                   (symbol->string name)))))

(define (value->string val)
  (cond
   ((boolean? val)
    (if val "on" "off"))
   ((number? val)
    (number->string val))
   ((symbol? val)
    (string-map (match-lambda
                     (#\- #\_)
                     (chr chr))
                   (symbol->string val)))
   (else val)))

(define (serialize-field field-name val)
  (if (eq? field-name 'pam-services)
      #t
      (format #t "~a ~a\n"
              (uglify-field-name field-name)
              (value->string val))))

(define serialize-string serialize-field)
(define serialize-boolean serialize-field)
(define serialize-number serialize-field)
(define (serialize-list field-name val)
  (map (cut serialize-field field-name <>) val))
(define-maybe string)
(define-maybe boolean)
(define-maybe number)

(define (ssl-option? val)
  (or (boolean? val)
      (eq? val 'start-tls)))
(define serialize-ssl-option serialize-field)
(define-maybe ssl-option)

(define (tls-reqcert-option? val)
  (member val '(never allow try demand hard)))
(define serialize-tls-reqcert-option serialize-field)
(define-maybe tls-reqcert-option)

(define (deref-option? val)
  (member val '(never searching finding always)))
(define serialize-deref-option serialize-field)
(define-maybe deref-option)

(define (comma-separated-list-of-strings? val)
  (and (list? val)
       (every string? val)))
(define (ignore-users-option? val)
  (or (comma-separated-list-of-strings? val)
      (eq? 'all-local val)))
(define (serialize-ignore-users-option field-name val)
  (serialize-field field-name (if (eq? 'all-local val)
                                  val
                                  (string-join val ","))))
(define-maybe ignore-users-option)

(define (log-option? val)
  (let ((valid-scheme? (lambda (scheme)
                         (or (string? scheme)
                             (member scheme '(none syslog))))))
    (match val
      ((scheme level)
       (and (valid-scheme? scheme)
            (member level '(crit error warning notice info debug))))
      ((scheme)
       (valid-scheme? scheme)))))
(define (serialize-log-option field-name val)
  (serialize-field field-name
                   (string-join (map (cut format #f "~a" <>) val))))

(define (valid-map? val)
  "Is VAL a supported map name?"
  (member val
          '(alias aliases ether ethers group host hosts netgroup network networks
            passwd protocol protocols rpc service services shadow)))

(define (scope-option? val)
  (let ((valid-scopes '(subtree onelevel base children)))
    (match val
      ((map-name scope)
       (and (valid-map? map-name)
            (member scope valid-scopes)))
      ((scope)
       (member scope valid-scopes)))))
(define (serialize-scope-option field-name val)
  (serialize-field field-name
                   (string-join (map (cut format #f "~a" <>) val))))

(define (map-entry? val)
  (match val
    (((? valid-map? map-name)
      (? string? attribute)
      (? string? new-attribute)) #t)
    (_ #f)))

(define (list-of-map-entries? val)
  (and (list? val)
       (every map-entry? val)))

(define (filter-entry? val)
  (match val
    (((? valid-map? map-name)
      (? string? filter-expression)) #t)
    (_ #f)))

(define (list-of-filter-entries? val)
  (and (list? val)
       (every filter-entry? val)))

(define (serialize-filter-entry field-name val)
  (serialize-field 'filter
                   (match val
                     (((? valid-map? map-name)
                       (? string? filter-expression))
                      (string-append (symbol->string map-name)
                                     " " filter-expression)))))

(define (serialize-list-of-filter-entries field-name val)
  (for-each (cut serialize-filter-entry field-name <>) val))

(define (serialize-map-entry field-name val)
  (serialize-field 'map
                   (match val
                     (((? valid-map? map-name)
                       (? string? attribute)
                       (? string? new-attribute))
                      (string-append (symbol->string map-name)
                                     " " attribute
                                     " " new-attribute)))))

(define (serialize-list-of-map-entries field-name val)
  (for-each (cut serialize-map-entry field-name <>) val))


(define-configuration nslcd-configuration
  (nss-pam-ldapd
   (file-like nss-pam-ldapd)
   "The NSS-PAM-LDAPD package to use.")

  ;; Runtime options
  (threads
   maybe-number
   "The number of threads to start that can handle requests and perform LDAP
queries.  Each thread opens a separate connection to the LDAP server.  The
default is to start 5 threads.")
  (uid
   (string "nslcd")
   "This specifies the user id with which the daemon should be run.")
  (gid
   (string "nslcd")
   "This specifies the group id with which the daemon should be run.")
  (log
   (log-option '("/var/log/nslcd" info))
   "This option controls the way logging is done via a list containing SCHEME
and LEVEL.  The SCHEME argument may either be the symbols \"none\" or
\"syslog\", or an absolute file name.  The LEVEL argument is optional and
specifies the log level.  The log level may be one of the following symbols:
\"crit\", \"error\", \"warning\", \"notice\", \"info\" or \"debug\".  All
messages with the specified log level or higher are logged.")

  ;; LDAP connection settings
  (uri
   (list '("ldap://localhost:389/"))
   "The list of LDAP server URIs.  Normally, only the first server will be
used with the following servers as fall-back.")
  (ldap-version
   maybe-string
   "The version of the LDAP protocol to use.  The default is to use the
maximum version supported by the LDAP library.")
  (binddn
   maybe-string
   "Specifies the distinguished name with which to bind to the directory
server for lookups.  The default is to bind anonymously.")
  (bindpw
   maybe-string
   "Specifies the credentials with which to bind.  This option is only
applicable when used with binddn.")
  (rootpwmoddn
   maybe-string
   "Specifies the distinguished name to use when the root user tries to modify
a user's password using the PAM module.")
  (rootpwmodpw
   maybe-string
   "Specifies the credentials with which to bind if the root user tries to
change a user's password.  This option is only applicable when used with
rootpwmoddn")

  ;; SASL authentication options
  (sasl-mech
   maybe-string
   "Specifies the SASL mechanism to be used when performing SASL
authentication.")
  (sasl-realm
   maybe-string
   "Specifies the SASL realm to be used when performing SASL authentication.")
  (sasl-authcid
   maybe-string
   "Specifies the authentication identity to be used when performing SASL
authentication.")
  (sasl-authzid
   maybe-string
   "Specifies the authorization identity to be used when performing SASL
authentication.")
  (sasl-canonicalize?
   maybe-boolean
   "Determines whether the LDAP server host name should be canonicalised.  If
this is enabled the LDAP library will do a reverse host name lookup.  By
default, it is left up to the LDAP library whether this check is performed or
not.")

  ;; Kerberos authentication options
  (krb5-ccname
   maybe-string
   "Set the name for the GSS-API Kerberos credentials cache.")

  ;; Search / mapping options
  (base
   (string "dc=example,dc=com")
   "The directory search base.")
  (scope
   (scope-option '(subtree))
   "Specifies the search scope (subtree, onelevel, base or children).  The
default scope is subtree; base scope is almost never useful for name service
lookups; children scope is not supported on all servers.")
  (deref
   maybe-deref-option
   "Specifies the policy for dereferencing aliases.  The default policy is to
never dereference aliases.")
  (referrals
   maybe-boolean
   "Specifies whether automatic referral chasing should be enabled.  The
default behaviour is to chase referrals.")
  (maps
   (list-of-map-entries '())
   "This option allows for custom attributes to be looked up instead of the
default RFC 2307 attributes.  It is a list of maps, each consisting of the
name of a map, the RFC 2307 attribute to match and the query expression for
the attribute as it is available in the directory.")
  (filters
   (list-of-filter-entries '())
   "A list of filters consisting of the name of a map to which the filter
applies and an LDAP search filter expression.")

  ;; Timing / reconnect options
  (bind-timelimit
   maybe-number
   "Specifies the time limit in seconds to use when connecting to the
directory server.  The default value is 10 seconds.")
  (timelimit
   maybe-number
   "Specifies the time limit (in seconds) to wait for a response from the LDAP
server.  A value of zero, which is the default, is to wait indefinitely for
searches to be completed.")
  (idle-timelimit
   maybe-number
   "Specifies the period if inactivity (in seconds) after which the con‐
nection to the LDAP server will be closed.  The default is not to time out
connections.")
  (reconnect-sleeptime
   maybe-number
   "Specifies the number of seconds to sleep when connecting to all LDAP
servers fails.  By default one second is waited between the first failure and
the first retry.")
  (reconnect-retrytime
   maybe-number
   "Specifies the time after which the LDAP server is considered to be
permanently unavailable.  Once this time is reached retries will be done only
once per this time period.  The default value is 10 seconds.")

  ;; TLS options
  (ssl
   maybe-ssl-option
   "Specifies whether to use SSL/TLS or not (the default is not to).  If
'start-tls is specified then StartTLS is used rather than raw LDAP over SSL.")
  (tls-reqcert
   maybe-tls-reqcert-option
   "Specifies what checks to perform on a server-supplied certificate.
The meaning of the values is described in the ldap.conf(5) manual page.")
  (tls-cacertdir
   maybe-string
   "Specifies the directory containing X.509 certificates for peer authen‐
tication.  This parameter is ignored when using GnuTLS.")
  (tls-cacertfile
   maybe-string
   "Specifies the path to the X.509 certificate for peer authentication.")
  (tls-randfile
   maybe-string
   "Specifies the path to an entropy source.  This parameter is ignored when
using GnuTLS.")
  (tls-ciphers
   maybe-string
   "Specifies the ciphers to use for TLS as a string.")
  (tls-cert
   maybe-string
   "Specifies the path to the file containing the local certificate for client
TLS authentication.")
  (tls-key
   maybe-string
   "Specifies the path to the file containing the private key for client TLS
authentication.")

  ;; Other options
  (pagesize
   maybe-number
   "Set this to a number greater than 0 to request paged results from the LDAP
server in accordance with RFC2696.  The default (0) is to not request paged
results.")
  (nss-initgroups-ignoreusers
   maybe-ignore-users-option
   "This option prevents group membership lookups through LDAP for the
specified users.  Alternatively, the value 'all-local may be used.  With that
value nslcd builds a full list of non-LDAP users on startup.")
  (nss-min-uid
   maybe-number
   "This option ensures that LDAP users with a numeric user id lower than the
specified value are ignored.")
  (nss-uid-offset
   maybe-number
   "This option specifies an offset that is added to all LDAP numeric user
ids.  This can be used to avoid user id collisions with local users.")
  (nss-gid-offset
   maybe-number
   "This option specifies an offset that is added to all LDAP numeric group
ids.  This can be used to avoid user id collisions with local groups.")
  (nss-nested-groups
   maybe-boolean
   "If this option is set, the member attribute of a group may point to
another group.  Members of nested groups are also returned in the higher level
group and parent groups are returned when finding groups for a specific user.
The default is not to perform extra searches for nested groups.")
  (nss-getgrent-skipmembers
   maybe-boolean
   "If this option is set, the group member list is not retrieved when looking
up groups.  Lookups for finding which groups a user belongs to will remain
functional so the user will likely still get the correct groups assigned on
login.")
  (nss-disable-enumeration
   maybe-boolean
   "If this option is set, functions which cause all user/group entries to be
loaded from the directory will not succeed in doing so.  This can dramatically
reduce LDAP server load in situations where there are a great number of users
and/or groups.  This option is not recommended for most configurations.")
  (validnames
   maybe-string
   "This option can be used to specify how user and group names are verified
within the system.  This pattern is used to check all user and group names
that are requested and returned from LDAP.")
  (ignorecase
   maybe-boolean
   "This specifies whether or not to perform searches using case-insensitive
matching.  Enabling this could open up the system to authorization bypass
vulnerabilities and introduce nscd cache poisoning vulnerabilities which allow
denial of service.")
  (pam-authc-ppolicy
   maybe-boolean
   "This option specifies whether password policy controls are requested and
handled from the LDAP server when performing user authentication.")
  (pam-authc-search
   maybe-string
   "By default nslcd performs an LDAP search with the user's credentials after
BIND (authentication) to ensure that the BIND operation was successful.  The
default search is a simple check to see if the user's DN exists.  A search
filter can be specified that will be used instead.  It should return at least
one entry.")
  (pam-authz-search
   maybe-string
   "This option allows flexible fine tuning of the authorisation check that
should be performed.  The search filter specified is executed and if any
entries match, access is granted, otherwise access is denied.")
  (pam-password-prohibit-message
   maybe-string
   "If this option is set password modification using pam_ldap will be denied
and the specified message will be presented to the user instead.  The message
can be used to direct the user to an alternative means of changing their
password.")

  ;; Options for extension of pam-root-service-type.
  (pam-services
   (list '())
   "List of pam service names for which LDAP authentication should suffice."))

(define %nslcd-accounts
  (list (user-group
         (name "nslcd")
         (system? #t))
        (user-account
         (name "nslcd")
         (group "nslcd")
         (comment "NSLCD service account")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin"))
         (system? #t))))

(define (nslcd-config-file config)
  "Return an NSLCD configuration file."
  (plain-file "nslcd.conf"
              (with-output-to-string
                (lambda ()
                  (serialize-configuration config nslcd-configuration-fields)
                  ;; The file must end with a newline character.
                  (format #t "\n")))))

;; XXX: The file should only be readable by root if it contains a "bindpw"
;; declaration.  Unfortunately, this etc-service-type extension does not
;; support setting file modes, so we do this in the activation service.
(define (nslcd-etc-service config)
  `(("nslcd.conf" ,(nslcd-config-file config))))

(define (nslcd-shepherd-service config)
  (list (shepherd-service
         (documentation "Run the nslcd service for resolving names from LDAP.")
         (provision '(nslcd))
         (requirement '(networking user-processes))
         (start #~(make-forkexec-constructor
                   (list (string-append #$(nslcd-configuration-nss-pam-ldapd config)
                                        "/sbin/nslcd")
                         "--nofork")
                   #:pid-file "/var/run/nslcd/nslcd.pid"
                   #:environment-variables
                   (list (string-append "LD_LIBRARY_PATH="
                                        #$(nslcd-configuration-nss-pam-ldapd config)
                                        "/lib"))))
         (stop #~(make-kill-destructor)))))

(define (pam-ldap-pam-service config)
  "Return a PAM service for LDAP authentication."
  (define pam-ldap-module
    (file-append (nslcd-configuration-nss-pam-ldapd config)
                     "/lib/security/pam_ldap.so"))
  (pam-extension
    (transformer
     (lambda (pam)
       (if (member (pam-service-name pam)
                   (nslcd-configuration-pam-services config))
           (let ((sufficient
                  (pam-entry
                   (control "sufficient")
                   (module pam-ldap-module))))
             (pam-service
              (inherit pam)
              (auth (cons sufficient (pam-service-auth pam)))
              (session (cons sufficient (pam-service-session pam)))
              (account (cons sufficient (pam-service-account pam)))))
           pam)))))

(define (pam-ldap-pam-services config)
  (list (pam-ldap-pam-service config)))

(define %nslcd-activation
  (with-imported-modules (source-module-closure '((gnu build activation)))
    #~(begin
        (use-modules (gnu build activation))
        (let ((rundir "/var/run/nslcd")
              (user (getpwnam "nslcd")))
          (mkdir-p/perms rundir user #o755)
          (when (file-exists? "/etc/nslcd.conf")
            (chmod "/etc/nslcd.conf" #o400))))))

(define nslcd-service-type
  (service-type
   (name 'nslcd)
   (description "Run the NSLCD service for looking up names from LDAP.")
   (extensions
    (list (service-extension account-service-type
                             (const %nslcd-accounts))
          (service-extension etc-service-type
                             nslcd-etc-service)
          (service-extension activation-service-type
                             (const %nslcd-activation))
          (service-extension pam-root-service-type
                             pam-ldap-pam-services)
          (service-extension nscd-service-type
                             (const (list nss-pam-ldapd)))
          (service-extension shepherd-root-service-type
                             nslcd-shepherd-service)))
   (default-value (nslcd-configuration))))

(define (generate-nslcd-documentation)
  (generate-documentation
   `((nslcd-configuration ,nslcd-configuration-fields))
   'nslcd-configuration))
em cmake-build-system)
    (inputs (list bzip2 ;optional
                  c-ares
                  libevent
                  openssl ;optional
                  xz ;optional
                  zlib))
    (native-inputs (list pkg-config))
    (arguments
     (list
      #:tests? #f ;Tests are "for development only".
      #:phases #~(modify-phases %standard-phases
                   ;; We want to provide good defaults. Here apt-cacher-ng is built
                   ;; without libwrap support so we disable that by default.
                   (add-before 'configure 'patch-config
                     (lambda _
                       (substitute* "conf/acng.conf.in"
                         (("# UseWrap: 0")
                          "UseWrap: 0")))))))
    (home-page "https://www.unix-ag.uni-kl.de/~bloch/acng/")
    (synopsis "Caching proxy for packages of various software distributions or
repositories")
    (description
     "This package mainly meant for caching packages of Debian or Debian
based distributions (like Trisquel) through HTTP.  It also has partial support
for HTTPS and other distributions / repositories (OpenSUSE, Arch Linux,
Sourceforge mirror network, Cygwin mirrors) as this requires more
configuration and comes with some limitations.  Packages can be imported
manually either by copying files from another apt-cacher-ng instance or by
importing them from CD, DVD, jigdo, etc.  While apt-cacher-ng can work offline,
it requires some online access before that to build valid index files.  It also
supports partial mirroring.  It can be configured through configuration files
and/or a web interface and/or a command line tool.")
    (license license:gpl3+)))

(define-public apt-mirror
  (let ((commit "e664486a5d8947c2579e16dd793d762ea3de4202")
        (revision "1"))
    (package
      (name "apt-mirror")
      (version (git-version "0.5.4" revision commit))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/apt-mirror/apt-mirror/")
                      (commit commit)))
                (file-name (git-file-name name version))
                (sha256
                 (base32
                  "0qj6b7gldwcqyfs2kp6amya3ja7s4vrljs08y4zadryfzxf35nqq"))))
      (build-system gnu-build-system)
      (outputs '("out"))
      (arguments
       `(#:tests? #f
         ;; sysconfdir is not PREFIXed in the makefile but DESTDIR is
         ;; honored correctly; we therefore use DESTDIR for our
         ;; needs. A more correct fix would involve patching.
         #:make-flags (list (string-append "DESTDIR=" (assoc-ref %outputs "out"))
                            "PREFIX=/")
         #:phases (modify-phases %standard-phases (delete 'configure))))
      (inputs
       (list wget perl))
      (home-page "https://apt-mirror.github.io/")
      (synopsis "Script for mirroring a Debian repository")
      (description
       "apt-mirror is a small tool that provides the ability to selectively
mirror @acronym{APT, advanced package tool} sources, including GNU/Linux
distributions such as Debian and Trisquel.")
      (license license:gpl2))))

(define-public dpkg
  (package
    (name "dpkg")
    (version "1.22.1")
    (source
      (origin
        (method git-fetch)
        (uri (git-reference
               (url "https://git.dpkg.org/git/dpkg/dpkg")
               (commit version)))
        (file-name (git-file-name name version))
        (sha256
         (base32 "1s6dzcczmpkr9pla25idymfdjz10gck0kphpp0vqbp92vmfskipg"))))
    (build-system gnu-build-system)
    (arguments
     (list #:modules
           `((srfi srfi-71)
             ,@%default-gnu-modules)
           #:phases
           #~(modify-phases %standard-phases
               (add-before 'bootstrap 'patch-version
                 (lambda _
                   (patch-shebang "build-aux/get-version")
                   (with-output-to-file ".dist-version"
                     (lambda () (display #$version)))))
               (add-after 'unpack 'set-perl-libdir
                 (lambda _
                   (let* ((perl #$(this-package-input "perl"))
                          (_ perl-version (package-name->name+version perl)))
                     (setenv "PERL_LIBDIR"
                             (string-append #$output
                                            "/lib/perl5/site_perl/"
                                            perl-version)))))
               (add-after 'install 'wrap-scripts
                 (lambda _
                   (with-directory-excursion (string-append #$output "/bin")
                     (for-each
                      (lambda (file)
                        (wrap-script file
                          ;; Make sure all perl scripts in "bin" find the
                          ;; required Perl modules at runtime.
                          `("PERL5LIB" ":" prefix
                            (,(string-append #$output
                                             "/lib/perl5/site_perl")
                             ,(getenv "PERL5LIB")))
                          ;; DPKG perl modules expect dpkg to be installed.
                          ;; Work around it by adding dpkg to the script's path.
                          `("PATH" ":" prefix (,(string-append #$output
                                                               "/bin")))))
                      (list "dpkg-architecture"
                            "dpkg-buildapi"
                            "dpkg-buildflags"
                            "dpkg-buildpackage"
                            "dpkg-checkbuilddeps"
                            "dpkg-distaddfile"
                            "dpkg-genbuildinfo"
                            "dpkg-genchanges"
                            "dpkg-gencontrol"
                            "dpkg-gensymbols"
                            "dpkg-mergechangelogs"
                            "dpkg-name"
                            "dpkg-parsechangelog"
                            "dpkg-scanpackages"
                            "dpkg-scansources"
                            "dpkg-shlibdeps"
                            "dpkg-source"
                            "dpkg-vendor"))))))))
    (native-inputs
     (list autoconf
           automake
           gettext-minimal
           gnupg                        ; to run t/Dpkg_OpenPGP.t
           libtool
           pkg-config
           perl-io-string))
    (inputs
     (list bzip2
           guile-3.0                    ; for wrap-script
           libmd
           ncurses
           perl
           xz
           zlib))
    (home-page "https://wiki.debian.org/Teams/Dpkg")
    (synopsis "Debian package management system")
    (description "This package provides the low-level infrastructure for
handling the installation and removal of Debian software packages.")
    (license license:gpl2+)))

(define-public pbuilder
  (package
    (name "pbuilder")
    (version "0.231")
    (source
      (origin
        (method git-fetch)
        (uri (git-reference
               (url "https://salsa.debian.org/pbuilder-team/pbuilder.git/")
               (commit version)))
        (file-name (git-file-name name version))
        (sha256
         (base32 "0z6f1fgcrkfql9ayc3d0nxra2y6cn91xd5lvr0hd8gdlp9xdvxbc"))))
    (build-system gnu-build-system)
    (arguments
     (list
       #:modules `((guix build gnu-build-system)
                   (guix build utils)
                   (srfi srfi-26))
       #:phases
       #~(modify-phases %standard-phases
           (delete 'configure)          ; no configure script
           (add-after 'unpack 'patch-source
             (lambda* (#:key inputs outputs #:allow-other-keys)

               ;; Documentation requires tldp-one-page.xsl
               (substitute* "Makefile"
                 ((".*-C Documentation.*") ""))

               ;; Don't create #$output/var/cache/pbuilder/...
               (substitute* '("Makefile"
                              "pbuildd/Makefile")
                 ((".*/var/cache/pbuilder.*") ""))

               ;; Find the correct fallback location.
               (substitute* '("pbuilder-checkparams"
                              "pbuilder-loadconfig"
                              "pbuilder-satisfydepends-apt"
                              "pbuilder-satisfydepends-aptitude"
                              "pbuilder-satisfydepends-classic"
                              "t/test_pbuilder-satisfydepends-classic")
                 (("\\$PBUILDER_ROOT(/usr)?") #$output))

               ;; Some hardcoded paths
               (substitute* '("debuild-pbuilder"
                              "pbuilder"
                              "pbuilder-buildpackage"
                              "pbuilderrc"
                              "pdebuild"
                              "pdebuild-checkparams"
                              "pdebuild-internal")
                 (("/usr/lib/pbuilder")
                  (string-append #$output "/lib/pbuilder")))
               (substitute* "pbuildd/buildd-config.sh"
                 (("/usr/share/doc/pbuilder")
                  (string-append #$output "/share/doc/pbuilder")))
               (substitute* "pbuilder-unshare-wrapper"
                 (("/(s)?bin/ifconfig") "ifconfig")
                 (("/(s)?bin/ip") (search-input-file inputs "/sbin/ip")))
               (substitute* "Documentation/Makefile"
                 (("/usr") ""))

               ;; Ensure PATH works both in Guix and within the Debian chroot.
               (substitute* "pbuilderrc"
                 (("PATH=\"/usr/sbin:/usr/bin:/sbin:/bin")
                  "PATH=\"$PATH:/usr/sbin:/usr/bin:/sbin:/bin"))))
           (add-after 'install 'create-etc-pbuilderrc
             (lambda* (#:key outputs #:allow-other-keys)
               (with-output-to-file (string-append #$output "/etc/pbuilderrc")
                 (lambda ()
                   (format #t "# A couple of presets to make this work more smoothly.~@
                           MIRRORSITE=\"http://deb.debian.org/debian\"~@
                           if [ -r /run/privileged/bin/sudo ]; then~@
                               PBUILDERROOTCMD=\"/run/privileged/bin/sudo -E\"~@
                           fi~@
                           PBUILDERSATISFYDEPENDSCMD=\"~a/lib/pbuilder/pbuilder-satisfydepends-apt\"~%"
                           #$output)))))
           (add-after 'install 'install-manpages
             (lambda* (#:key outputs #:allow-other-keys)
               (let ((man (string-append #$output "/share/man/")))
                 (install-file "debuild-pbuilder.1" (string-append man "man1"))
                 (install-file "pdebuild.1" (string-append man "man1"))
                 (install-file "pbuilder.8" (string-append man "man8"))
                 (install-file "pbuilderrc.5" (string-append man "man5")))))
           (add-after 'install 'wrap-programs
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (for-each
                 (lambda (file)
                   (wrap-script file
                    `("PATH" ":" prefix
                      ,(map (compose dirname (cut search-input-file inputs <>))
                            (list "/bin/cut"
                                  "/bin/dpkg"
                                  "/bin/grep"
                                  "/bin/perl"
                                  "/bin/sed"
                                  "/bin/which"
                                  "/sbin/debootstrap")))))
                 (cons*
                   (string-append #$output "/bin/pdebuild")
                   (string-append #$output "/sbin/pbuilder")
                   (find-files (string-append #$output "/lib/pbuilder"))))))
           ;; Move the 'check phase to after 'install.
           (delete 'check)
           (add-after 'validate-runpath 'check
             (assoc-ref %standard-phases 'check)))
         #:make-flags
         ;; No PREFIX, use DESTDIR instead.
         #~(list (string-append "DESTDIR=" #$output)
                 (string-append "SYSCONFDIR=" #$output "/etc")
                 (string-append "BINDIR=" #$output "/bin")
                 (string-append "PKGLIBDIR=" #$output "/lib/pbuilder")
                 (string-append "SBINDIR=" #$output "/sbin")
                 (string-append "PKGDATADIR=" #$output "/share/pbuilder")
                 (string-append "EXAMPLEDIR=" #$output "/share/doc/pbuilder/examples")
                 "PBUILDDDIR=/share/doc/pbuilder/examples/pbuildd/")))
    (inputs
     (list dpkg
           debootstrap
           grep
           guile-3.0            ; for wrap-script
           iproute
           perl
           which))
    (native-inputs
     (list man-db
           util-linux))
    (home-page "https://pbuilder-team.pages.debian.net/pbuilder/")
    (synopsis "Personal package builder for Debian packages")
    (description
     "@code{pbuilder} is a personal package builder for Debian packages.
@itemize
@item@code{pbuilder} constructs a chroot system, and builds a package inside the
chroot.  It is an ideal system to use to check that a package has correct
build-dependencies.  It uses @code{apt} extensively, and a local mirror, or a
fast connection to a Debian mirror is ideal, but not necessary.
@item@code{pbuilder create} uses debootstrap to create a chroot image.
@item@code{pbuilder update} updates the image to the current state of
testing/unstable/whatever.
@item@code{pbuilder build} takes a @code{*.dsc} file and builds a binary in the
chroot image.
@item@code{pdebuild} is a wrapper for Debian Developers, to allow running
@code{pbuilder} just like @code{debuild}, as a normal user.
@end itemize")
    (license license:gpl2+)))

(define-public reprepro
  (package
    (name "reprepro")
    (version "5.3.0")
    (source
      (origin
        (method git-fetch)
        (uri (git-reference
               (url "https://salsa.debian.org/brlink/reprepro.git/")
               (commit (string-append name "-" version))))
        (file-name (git-file-name name version))
        (sha256
         (base32
          "1kn7m5rxay6q2c4vgjgm4407xx2r46skkkb6rn33m6dqk1xfkqnh"))))
    (build-system gnu-build-system)
    (arguments
     `(#:tests? #f ; testtool not found
       #:phases
       (modify-phases %standard-phases
         (replace 'check
           (lambda* (#:key tests? #:allow-other-keys)
             (if tests?
               (with-directory-excursion "tests"
                 (invoke (which "sh") "test.sh"))
               #t)))
         (add-after 'install 'install-completions
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out  (assoc-ref outputs "out"))
                    (bash (string-append out "/etc/bash_completion.d/"))
                    (zsh  (string-append out "/share/zsh/site-fucnctions/")))
               (mkdir-p bash)
               (mkdir-p zsh)
               (copy-file "docs/reprepro.bash_completion"
                          (string-append bash "reprepro"))
               (copy-file "docs/reprepro.zsh_completion"
                          (string-append zsh "_reprepro"))
               #t))))))
    (inputs
     (list bdb
           bzip2
           gpgme
           libarchive
           xz
           zlib))
    (native-inputs
     (list autoconf automake))
    (home-page "https://salsa.debian.org/brlink/reprepro")
    (synopsis "Debian package repository producer")
    (description "Reprepro is a tool to manage a repository of Debian packages
(@code{.deb}, @code{.udeb}, @code{.dsc}, ...).  It stores files either being
injected manually or downloaded from some other repository (partially) mirrored
into one pool/ hierarchy.  Managed packages and files are stored in a Berkeley
DB, so no database server is needed.  Checking signatures of mirrored
repositories and creating signatures of the generated Package indices is
supported.")
    (license license:gpl2)))