path: root/src/xyz/euandreh/queue.scm

(define-module (xyz euandreh queue)
  #:use-module ((guix licenses) #:prefix license:)
  ;; #:use-module ((nonguix licenses) #:prefix ng-license:)
  #:use-module ((srfi srfi-1) #:prefix srfi-1:)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system python)
  #:use-module (guix build-system trivial)
  #:use-module (guix download)
  #:use-module (guix gexp)
  #:use-module (guix git-download)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:use-module (gnu)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages check)
  #:use-module (gnu packages cpio)
  #:use-module (gnu packages cups)
  #:use-module (gnu packages cyrus-sasl)
  #:use-module (gnu packages dbm)
  #:use-module (gnu packages image)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages mail)
  #:use-module (gnu packages m4)
  #:use-module (gnu packages onc-rpc)
  #:use-module (gnu packages package-management)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages python-build)
  #:use-module (gnu packages python-crypto)
  #:use-module (gnu packages python-web)
  #:use-module (gnu packages python-xyz)
  #:use-module (gnu packages time)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages xml)
  #:use-module (gnu services shepherd)
  #:export (<shadow-group-configuration>
             shadow-group-configuration
             shadow-group-configuration-group

             shadow-group-activation
             shadow-group-accounts
             shadow-group-service-type


            <cyrus-service-configuration>
             cyrus-service-configuration
             cyrus-service-configuration-name
             cyrus-service-configuration-authmech
             cyrus-service-configuration-log-level

            <cyrus-sasl-configuration>
             cyrus-sasl-configuration
             cyrus-sasl-configuration-cyrus-sasl
             cyrus-sasl-configuration-authmech
             cyrus-sasl-configuration-services
             cyrus-sasl-configuration-state-dir

             cyrus-sasl-etc-files
             cyrus-sasl-activation
             cyrus-sasl-shepherd-service
             cyrus-sasl-service-type


            <dkimproxyout-configuration>
             dkimproxyout-configuration
             dkimproxyout-configuration-dkimproxy
             dkimproxyout-configuration-user
             dkimproxyout-configuration-group
             dkimproxyout-configuration-listen
             dkimproxyout-configuration-relay
             dkimproxyout-configuration-domains
             dkimproxyout-configuration-selector
             dkimproxyout-configuration-key-size
             dkimproxyout-configuration-data-directory

             dkimproxyout-etc-files
             dkimproxyout-accounts
             dkimproxyout-activation
             dkimproxyout-shepherd-service
             dkimproxyout-service-type))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-public epson-L365
  (package
    (name "epson-L365")
    (version "1.0.0")
    (source
      (origin
        (method url-fetch)
        (uri
          (string-append
           "https://download3.ebz.epson.net/dsc/f/03/00/03/45/41/92e9c9254f0ee4230a069545ba27ec2858a2c457/epson-inkjet-printer-201401w-"
           version
           "-1lsb3.2.src.rpm"))
        (sha256
          (base32 "0c60m1sd59s4sda38dc5nniwa7dh1b0kv1maajr0x9d38gqlyk3x"))))
    (build-system gnu-build-system)
    (arguments
      (list
       #:phases
       #~(modify-phases %standard-phases
          (replace 'unpack
            (lambda* (#:key outputs #:allow-other-keys)
              (mkdir "source")
              (chdir "source")
              (system (string-append "rpm2cpio " #$source " | cpio -idv"))
              (invoke "tar" "-xvf" (string-append "epson-inkjet-printer-201401w-" #$version ".tar.gz"))
              (invoke "tar" "-xvf" (string-append "epson-inkjet-printer-filter-"  #$version ".tar.gz"))
              (substitute* (find-files (string-append "epson-inkjet-printer-201401w-" #$version "/ppds/"))
                (("/opt/epson-inkjet-printer-201401w/cups/lib")
                 (string-append (assoc-ref outputs "out")
                                "/lib/cups")))
              (chdir (string-append "epson-inkjet-printer-filter-" #$version))))
          (add-after 'install 'install-extra-files
            (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (model-dir (string-append out "/share/cups/model/epson-inkjet-printer-201401w")))
                (chdir (string-append "../epson-inkjet-printer-201401w-" #$version))
                (mkdir-p model-dir)
                (invoke "cp" "-a" "ppds" model-dir)
                (invoke "cp" "-a" "lib64" "resource" "watermark" out)))))))
    (native-inputs
      (list cpio
            cups-minimal
            libjpeg-turbo
            rpm))
    (synopsis
     "Epson printer driver (L456, L455, L366, L365, L362, L360, L312, L310, L222, L220, L132, L130)")
    (description
     "This software is a filter program used with the Common UNIX Printing
System (CUPS) under Linux.  It supplies high quality printing with
Seiko Epson Color Ink Jet Printers.")
    (home-page "https://www.openprinting.org/driver/epson-201401w")
    (license                  ;; SEIKO EPSON CORPORATION SOFTWARE LICENSE AGREEMENT
      (list #; (ng-license:nonfree "https://epson.com/SoftwareLicenseAgreement")
            license:lgpl2.1))))

(define-public python-docx
  (package
    (name "python-docx")
    (version "0.8.11")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "python-docx" version))
        (sha256
          (base32 "1i7bxghb7knlyjain101qg1jmmz2b6qj03bi3vfxhvcml0rx418i"))))
    (build-system python-build-system)
    (arguments
      `(#:tests? #f))
    (propagated-inputs
      (list python-lxml))
    (native-inputs
      (list python-pytest
            ;; python-behave
            python-mock))
    (home-page "https://github.com/python-openxml/python-docx")
    (synopsis "Create and update Microsoft Word .docx files.")
    (description "Create and update Microsoft Word .docx files.")
    (license #f)))

(define-public python-pytest-tornado5
  (package
    (name "python-pytest-tornado5")
    (version "2.0.0")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "pytest-tornado5" version))
        (sha256
         (base32 "0qb62jw2w0xr6y942yp0qxiy755bismjfpnxaxjjm05gy2pymr8d"))))
    (build-system python-build-system)
    (propagated-inputs (list python-pytest python-tornado))
    (home-page "https://github.com/vidartf/pytest-tornado")
    (synopsis
     "A py.test plugin providing fixtures and markers to simplify testing of asynchronous tornado applications.")
    (description
     "This package provides a py.test plugin providing fixtures and markers to
simplify testing of asynchronous tornado applications.")
    (license license:asl2.0)))

;; FIXME
#;
(define-public python-futures
  (package
    (name "python-futures")
    (version "3.3.0")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "futures" version))
        (sha256
          (base32 "154pvaybk9ncyb1wpcnzgd7ayvvhhzk92ynsas7gadaydbvkl0vy"))))
    (build-system python-build-system)
    (home-page "https://github.com/agronholm/pythonfutures")
    (synopsis "Backport of the concurrent.futures package from Python 3")
    (description "Backport of the concurrent.futures package from Python 3")
    (license #f)))

(define-public python-ordereddict
  (package
    (name "python-ordereddict")
    (version "1.1")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "ordereddict" version))
        (sha256
          (base32 "07qvy11nvgxpzarrni3wrww3vpc9yafgi2bch4j2vvvc42nb8d8w"))))
    (build-system python-build-system)
    (arguments
      `(#:phases
        (modify-phases %standard-phases
          (delete 'sanity-check))))
    (home-page "UNKNOWN")
    (synopsis
     "A drop-in substitute for Py2.7's new collections.OrderedDict that works in Python 2.4-2.6.")
    (description "This package provides a drop-in substitute for Py2.7's new
collections.OrderedDict that works in Python 2.4-2.6.")
    (license #f)))

(define-public python-funcsigs
  (package
    (name "python-funcsigs")
    (version "1.0.2")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "funcsigs" version))
        (sha256
          (base32 "0l4g5818ffyfmfs1a924811azhjj8ax9xd1cffr1mzd3ycn0zfx7"))))
    (build-system python-build-system)
    (propagated-inputs
      (list python-ordereddict))
    (native-inputs
      (list python-unittest2))
    (home-page "http://funcsigs.readthedocs.org")
    (synopsis
     "Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
    (description
     "Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
    (license #f)))

(define-public python-apscheduler
  (package
    (name "python-apscheduler")
    (version "3.9.1")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "APScheduler" version))
        (sha256
          (base32 "1qzi1pr7q72vs49p7vr1mp350zaggs52lpq43lvqsjcmcd5mgrk5"))))
    (build-system python-build-system)
    (arguments
      `(#:tests? #f))
    (propagated-inputs
      (list python-funcsigs
            ; python-futures
            python-pytz
            python-setuptools
            python-six
            python-tzlocal))
    (native-inputs
      (list python-mock
            python-pytest
            python-pytest-asyncio
            python-pytest-cov
            python-pytest-tornado5
            python-setuptools-scm))
    (home-page "https://github.com/agronholm/apscheduler")
    (synopsis "In-process task scheduler with Cron-like capabilities")
    (description "In-process task scheduler with Cron-like capabilities")
    (license license:expat)))

(define-public python-telegram-bot
  (package
    (name "python-telegram-bot")
    (version "13.12")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "python-telegram-bot" version))
        (sha256
          (base32 "1rbdyr1f9mndlh83in47k8if65yp9n1dy4px2wipbf0qyjv5zxfs"))))
    (build-system python-build-system)
    (arguments
      `(#:tests? #f
        #:phases
        (modify-phases %standard-phases
          (delete 'sanity-check))))
    (native-inputs
      (list python-apscheduler))
    (propagated-inputs
      (list python-apscheduler
            python-cachetools
            python-certifi
            python-pytz
            python-tornado))
    (home-page "https://python-telegram-bot.org/")
    (synopsis "We have made you a wrapper you can't refuse")
    (description "We have made you a wrapper you can't refuse")
    (license #f)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; services ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-record-type* <shadow-group-configuration>
  shadow-group-configuration
  make-shadow-group-configuration
  shadow-group-configuration?
  (group shadow-group-configuration-group (default "etc-shadow")))

(define (shadow-group-activation config)
  (match-record config <shadow-group-configuration>
      (group)
    #~(begin
        (use-modules (guix build utils))
        (format (current-error-port)
         "Setting ownership and permission for \"/etc/passwd\".~%")
        (chown "/etc/shadow"
               (passwd:uid (getpwnam "root"))
               (group:gid  (getgrnam #$group)))
        (chmod "/etc/shadow" #o640))))

(define (shadow-group-accounts config)
  (match-record config <shadow-group-configuration>
      (group)
    (list
     (user-group
       (name group)
       (system? #t)))))

(define shadow-group-service-type
  (service-type
    (name 'shadow-group)
    (extensions
      (list
       (service-extension activation-service-type
                          shadow-group-activation)
       (service-extension account-service-type
                          shadow-group-accounts)))
    (default-value (shadow-group-configuration))
    (description "FIXME:DOCUMENTATION: heredoc syntax?")))


(define-record-type* <cyrus-service-configuration>
  cyrus-service-configuration
  make-cyrus-service-configuration
  cyrus-service-configuration?
  (name      cyrus-service-configuration-name)
  (authmech  cyrus-service-configuration-authmech  (default "saslauthd"))
  (log-level cyrus-service-configuration-log-level (default 7)))

(define-record-type* <cyrus-sasl-configuration>
  cyrus-sasl-configuration
  make-cyrus-sasl-configuration
  cyrus-sasl-configuration?
  (cyrus-sasl           cyrus-sasl-configuration-cyrus-sasl           (default cyrus-sasl))
  (user                 cyrus-sasl-configuration-user                 (default "cyrus-sasl"))
  (group                cyrus-sasl-configuration-group                (default "cyrus-sasl"))
  (supplementary-groups cyrus-sasl-configuration-supplementary-groups (default '("etc-shadow")))
  (authmech             cyrus-sasl-configuration-authmech             (default "shadow"))
  (services             cyrus-sasl-configuration-services             (default '()))
  (state-dir            cyrus-sasl-configuration-state-dir            (default "/var/lib/saslauthd")))

(define (cyrus-sasl-etc-files config)
  (match-record config <cyrus-sasl-configuration>
      (services state-dir)
    `(("sasl2"
       ,(file-union
         "cyrus-sasl"
         (map (lambda (service-config)
                (match-record service-config <cyrus-service-configuration>
                    (name authmech log-level)
                  `(,name ,(plain-file
                            name
                            (format #f
                             "pwcheck_method: ~a~%saslauthd_path: ~a/mux~%log_level: ~a~%"
                             authmech
                             state-dir
                             log-level)))))
              services))))))

(define (cyrus-sasl-activation config)
  (match-record config <cyrus-sasl-configuration>
      (user state-dir)
    #~(begin
        (use-modules (guix build utils))
        (let ((user (getpwnam #$user)))
          (format (current-error-port)
           "Creating Cyrus SASL socket directory: \"~a\".~%" #$state-dir)
          (mkdir-p #$state-dir)
          (chown #$state-dir (passwd:uid user) (passwd:gid user))
          (chmod #$state-dir #o755)))))

(define (cyrus-sasl-accounts config)
  (match-record config <cyrus-sasl-configuration>
      (user group supplementary-groups)
    (list
     (user-account
       (name user)
       (group group)
       (supplementary-groups supplementary-groups)
       (comment "Cyrus SASL system user")
       (home-directory "/var/empty")
       (shell (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t)))))

(define (cyrus-sasl-shepherd-service config)
  (match-record config <cyrus-sasl-configuration>
      (cyrus-sasl user group supplementary-groups authmech state-dir)
    (list
     (shepherd-service
       (provision '(cyrus-sasl))
       (documentation "FIXME:DOCUMENTATION: heredoc syntax?")
       (start #~(make-forkexec-constructor
                 (list
                  #$(file-append cyrus-sasl "/sbin/saslauthd")
                  "-a"
                  #$authmech
                  "-d"
                  "-m"
                  #$state-dir)
                 #:user #$user
                 #:group #$group
                 #:supplementary-groups #$supplementary-groups))
       (stop #~(make-kill-destructor))))))

(define cyrus-sasl-service-type
  (service-type
    (name 'cyrus-sasl)
    (extensions
      (list
       (service-extension etc-service-type
                          cyrus-sasl-etc-files)
       (service-extension activation-service-type
                          cyrus-sasl-activation)
       (service-extension profile-service-type
                          (compose list cyrus-sasl-configuration-cyrus-sasl))
       (service-extension account-service-type
                          cyrus-sasl-accounts)
       (service-extension shepherd-root-service-type
                          cyrus-sasl-shepherd-service)))
    (compose srfi-1:concatenate)
    (extend (lambda (config services)
              (cyrus-sasl-configuration
                (inherit config)
                (services
                  (append
                   (cyrus-sasl-configuration-services config)
                   services)))))
    (default-value (cyrus-sasl-configuration))
    (description "FIXME:DOCUMENTATION: heredoc syntax?")))


(define-record-type* <dkimproxyout-configuration>
  dkimproxyout-configuration
  make-dkimproxyout-configuration
  dkimproxyout-configuration?
  (dkimproxy      dkimproxyout-configuration-dkimproxy      (default dkimproxy))
  (user           dkimproxyout-configuration-user           (default "dkimproxyout"))
  (group          dkimproxyout-configuration-group          (default "dkimproxyout"))
  (config-name    dkimproxyout-configuration-config-name    (default "dkimproxyout.conf"))
  (listen         dkimproxyout-configuration-listen         (default "127.0.0.1:10027"))
  (relay          dkimproxyout-configuration-relay          (default "127.0.0.1:10028"))
  (domains        dkimproxyout-configuration-domains        (default (list (gethostname))))
  (selector       dkimproxyout-configuration-selector       (default "dkimproxy"))
  (key-size       dkimproxyout-configuration-key-size       (default 2048))
  (data-directory dkimproxyout-configuration-data-directory (default "/var/lib/dkimproxyout")))

(define (generate-out.cf config)
  (match-record config <dkimproxyout-configuration>
      (listen relay domains selector data-directory)
    (format #f
"
listen ~a
relay ~a

domain ~a
selector ~a

signature dkim(c=relaxed/relaxed)

# FIXME:DOCUMENTATION add this to the service documentation
# the corresponding public key is available at:
# ~a/public.key
keyfile ~a/private.key
"
       listen
       relay
       (string-join domains ",")
       selector
       data-directory
       data-directory)))

(define (dkimproxyout-etc-files config)
  (match-record config <dkimproxyout-configuration>
      (config-name)
    `((,config-name ,(plain-file config-name (generate-out.cf config))))))

(define (dkimproxyout-accounts config)
  (match-record config <dkimproxyout-configuration>
      (user group)
    (list
     (user-account
       (name user)
       (group group)
       (comment "DKIMproxy.out signing system user")
       (home-directory "/var/empty")
       (shell (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t)))))

(define (dkimproxyout-activation config)
  (match-record config <dkimproxyout-configuration>
      (user group data-directory key-size)
    #~(begin
        (use-modules (guix build utils))
        (let ((uid (passwd:uid (getpwnam #$user)))
              (gid (group:gid  (getgrnam #$group))))
          (format (current-error-port)
           "Creating DKIMproxy.out data directory: \"~a\".~%" #$data-directory)
          (mkdir-p #$data-directory)
          (chown #$data-directory uid gid)
          (chmod #$data-directory #o755)
          (let ((private-key (string-append #$data-directory "/private.key"))
                (public-key  (string-append #$data-directory "/public.key")))
            (unless (file-exists? private-key)
              (cond
                ((zero? (system* #$(file-append openssl "/bin/openssl")
                                 "genrsa"
                                 "-out"
                                 private-key
                                 (number->string #$key-size)))
                 (format (current-error-port)
                  "DKIMproxy.out private key file created: \"~a\".~%" private-key))
                (else
                 (format (current-error-port)
                  "Failed to create DKIMproxy.out private key file: \"~a\".~%" private-key))))
            (invoke #$(file-append openssl "/bin/openssl")
                    "rsa"
                    "-in"
                    private-key
                    "-pubout"
                    "-out"
                    public-key)
            (format (current-error-port)
             "Setting permissions for the public/private DKIMproxy.out keypair: \"~a/{public,private}.key\".~%" #$data-directory)
            (chown private-key uid gid)
            (chown public-key  uid gid)
            (chmod private-key #o400)
            (chmod public-key  #o644))))))

(define (dkimproxyout-shepherd-service config)
  (match-record config <dkimproxyout-configuration>
      (dkimproxy user group config-name)
    (let ((config-file (string-append "/etc/" config-name)))
      (list
       (shepherd-service
         (provision '(dkimproxyout))
         (documentation "FIXME:DOCUMENTATION: heredoc syntax?")
         (start #~(make-forkexec-constructor
                   (list
                    #$(file-append dkimproxy "/bin/dkimproxy.out")
                    "--conf_file" #$config-file
                    "--user"      #$user
                    "--group"     #$group)
                   #:user  #$user
                   #:group #$group))
         (stop #~(make-kill-destructor))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "FIXME:DOCUMENTATION: heredoc syntax?")
              (procedure
                #~(lambda _
                    (format #t "~a~%" #$config-file)))))))))))

(define-public dkimproxyout-service-type
  (service-type
    (name 'dkimproxyout)
    (extensions
      (list
       (service-extension etc-service-type
                          dkimproxyout-etc-files)
       (service-extension account-service-type
                          dkimproxyout-accounts)
       (service-extension activation-service-type
                          dkimproxyout-activation)
       (service-extension profile-service-type
                          (compose list dkimproxyout-configuration-dkimproxy))
       (service-extension shepherd-root-service-type
                          dkimproxyout-shepherd-service)))
    (default-value (dkimproxyout-configuration))
    (description "FIXME:DOCUMENTATION: heredoc syntax?")))



(list
 epson-L365
 python-docx
 python-telegram-bot)