Subject: [PATCH] gnu: Add qdk.

From: Danny Milosavljevic <[email-masked]>
Date: Fri, 19 Jun 2020 02:39:13 +0200

* gnu/packages/embedded.scm (qdk): New variable.
---
 gnu/packages/embedded.scm | 256 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 256 insertions(+)

diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm
index 9be1065de2..c0fc534320 100644
--- a/gnu/packages/embedded.scm
+++ b/gnu/packages/embedded.scm
@@ -39,18 +39,23 @@
   #:use-module (gnu packages autotools)
   #:use-module ((gnu packages base) #:prefix base:)
   #:use-module (gnu packages bison)
+  #:use-module (gnu packages compression)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages dejagnu)
   #:use-module (gnu packages flex)
+  #:use-module (gnu packages gawk)
   #:use-module (gnu packages gcc)
   #:use-module (gnu packages gdb)
+  #:use-module (gnu packages gnupg)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages libftdi)
   #:use-module (gnu packages libusb)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages perl)
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python)
   #:use-module (gnu packages python-xyz)
+  #:use-module (gnu packages rsync)
   #:use-module (gnu packages swig)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages xorg)
@@ -1352,3 +1357,254 @@ simplifies configuration and is also pluggable: you can write your own west
 this feature to provide conveniences for building applications, flashing and
 debugging them, and more.")
     (license license:expat)))
+
+(define-public qdk
+  (package
+    (name "qdk")
+    (version "2.3.11")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/qnap-dev/QDK.git")
+                    (commit (string-append "v" version))))
+              (file-name (string-append name "-" version "-checkout"))
+              (sha256
+               (base32
+                "1zp045b1wqwjq2aah46dv08bz9i841acrmy328q5i8filbndvjx1"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f             ; No tests
+       #:make-flags '("CC=gcc")
+       #:modules
+       ((guix build gnu-build-system)
+        (guix build utils)
+        (ice-9 regex)
+        (ice-9 match)
+        (ice-9 rdelim)
+        (ice-9 textual-ports)
+        (srfi srfi-1))
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch-references
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (define (substitute-without-HERE file pattern+procs)
+               "PATTERN+PROCS is a list of regexp/two-argument-procedure pairs.
+For each line of FILE, and for each PATTERN that it matches, call the
+corresponding PROC as (PROC LINE MATCHES); PROC must return the line that will
+be written as a substitution of the original line.  Be careful about using '$'
+to match the end of a line; by itself it won't match the terminating newline
+of a line.
+
+HERE document contents are ignored."
+               (let ((rx+proc  (map (match-lambda
+                                     (((? regexp? pattern) . proc)
+                                      (cons pattern proc))
+                                     ((pattern . proc)
+                                      (cons (make-regexp pattern regexp/extended)
+                                            proc)))
+                                    pattern+procs)))
+                 (with-atomic-file-replacement file
+                  (lambda (in out)
+                    (let loop ((line (read-line in 'concat))
+                               (in-HERE? #f))
+                      (if (eof-object? line)
+                          #t
+                          (let ((line (fold (lambda (r+p line)
+                                              (match r+p
+                                               ((regexp . proc)
+                                                (match (list-matches regexp line)
+                                                 ((and m+ (_ _ ...))
+                                                  (proc line m+))
+                                                 (_ line)))))
+                                            line
+                                            rx+proc)))
+                            (display line out)
+                            (loop (read-line in 'concat)
+                                  (or (and in-HERE? (not (string-contains line "EOF"))
+                                      (string-contains line "<<-EOF")))))))))))
+;; That was copied from guix/build/utils.scm.
+(define-syntax let-matches
+  ;; Helper macro for `substitute*'.
+  (syntax-rules (_)
+    ((let-matches index match (_ vars ...) body ...)
+     (let-matches (+ 1 index) match (vars ...)
+                  body ...))
+    ((let-matches index match (var vars ...) body ...)
+     (let ((var (match:substring match index)))
+       (let-matches (+ 1 index) match (vars ...)
+                    body ...)))
+    ((let-matches index match () body ...)
+     (begin body ...))))
+
+             (define (make-substitutor callback)
+                      (lambda (l m+)
+                        ;; Iterate over matches M+ and return the
+                        ;; modified line based on L.
+                        (let loop ((m* m+)  ; matches
+                                   (o  0)   ; offset in L
+                                   (r  '())) ; result
+                          (match m*
+                            (()
+                             (let ((r (cons (substring l o) r)))
+                               (string-concatenate-reverse r)))
+                            ((m . rest)
+                             (let-matches 0 m (v) ; or ()
+                               (loop rest
+                                     (match:end m)
+                                     (cons*
+                                      (callback l m+)
+                                      (substring l o (match:start m))
+                                      r))))))))
+             (substitute-without-HERE "shared/bin/qbuild"
+              `(("command -v awk" .
+                ,(make-substitutor (lambda (line matches)
+                    (string-append "command -v " (assoc-ref inputs "gawk") "/bin/gawk"))))
+                ("command -v cmp" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append "command -v " (assoc-ref inputs "diffutils")
+                                   "/bin/cmp"))))
+                ("command -v python2" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append "command -v " (assoc-ref inputs "python-2") "/bin/python2"))))
+                ("command -v md5sum" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append "command -v " (assoc-ref inputs "coreutils") "/bin/md5sum"))))
+                ("command -v gpg2" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append "command -v " (assoc-ref inputs "gnupg") "/bin/gpg"))))
+                ("qpkg_encrypt " .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref outputs "out")
+                                   "/share/QDK/bin/qpkg_encrypt "))))
+                ;("/usr/bin" . ,(lambda (line matches)
+                ;  "/bin"))
+                ("/usr/bin/hexdump\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "util-linux")
+                                   "/bin/hexdump"))))
+                ("/usr/bin/rsync\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "rsync") "/bin/rsync"))))
+                ("/usr/bin/expr\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/expr"))))
+                ("/usr/bin/bunzip2\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "bzip2")
+                                   "/bin/bunzip2"))))
+                ("/usr/local/sbin/7z\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "p7zip") "/bin/7z"))))
+                ("/usr/bin/whoami\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/whoami"))))
+                ("/usr/bin/tail\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/tail"))))
+                ("/usr/bin/basename\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/basename"))))
+                ("/bin/grep\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "grep") "/bin/grep"))))
+                ("/bin/sed\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "sed") "/bin/sed"))))
+                ("/bin/dd\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils") "/bin/dd"))))
+                ("/bin/ls\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils") "/bin/ls"))))
+                ("/bin/rm\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils") "/bin/rm"))))
+                ("/bin/cp\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils") "/bin/cp"))))
+                ("/bin/cut\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/cut"))))
+                ("/bin/tar\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "tar") "/bin/tar"))))
+                ("/bin/gzip\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "gzip") "/bin/gzip"))))
+                ("/bin/mkdir\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/mkdir"))))
+                ("/bin/cat\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/cat"))))
+                ("/bin/echo\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/echo"))))
+                ("/bin/uname\\>" .
+                 ,(make-substitutor (lambda (line matches)
+                    (string-append (assoc-ref inputs "coreutils")
+                                   "/bin/uname"))))
+                ("/etc/config/qdk.conf" .
+                 ,(make-substitutor (lambda (line matches)
+                   (string-append (assoc-ref outputs "out")
+                                  "/etc/config/qdk.conf"))))
+                ("/usr/bin" .
+                 ,(lambda (line matches)
+                    "@ERROR@"))
+                ("\\</bin" .
+                 ,(lambda (line matches)
+                    "@ERROR@"))))
+             (call-with-input-file "shared/bin/qbuild"
+               (lambda (port)
+                 (when (string-contains (get-string-all port) "@ERROR@")
+                   (error "Unpatched references remain"))))
+             #t))
+         (add-after 'patch-references 'chdir
+           (lambda _
+             (chdir "src")
+             #t))
+         (delete 'configure)
+         (replace 'install
+           (lambda* (#:key outputs #:allow-other-keys)
+             (chdir "..")
+             ;; See InstallUbuntu.sh.
+             (let* ((out (assoc-ref outputs "out"))
+                    (share (string-append out "/share/QDK"))
+                    (etc (string-append out "/etc/config"))
+                    (bin (string-append out "/bin")))
+               (mkdir-p share)
+               (copy-recursively "shared" share)
+               (mkdir-p etc)
+               (install-file "shared/qdk.conf" etc)
+               (substitute* (string-append etc "/qdk.conf")
+                 (("^QDK_PATH_P=.*")
+                  (string-append "QDK_PATH_P=" (dirname share) "\n")))
+               ;; For user convenience--not in original InstallUbuntu.sh.
+               (install-file "shared/bin/qbuild" bin)
+               #t))))))
+    (native-inputs
+     `(("bzip2" ,bzip2)
+       ("coreutils" ,base:coreutils)
+       ("diffutils" ,base:diffutils)
+       ("gawk" ,gawk)
+       ("gnupg" ,gnupg)
+       ("grep" ,base:grep)
+       ("gzip" ,gzip)
+       ("p7zip" ,p7zip)
+       ("python-2" ,python-2)
+       ("rsync" ,rsync)
+       ("sed" ,base:sed)
+       ("tar" ,base:tar)
+       ("util-linux" ,util-linux)))
+    (synopsis "QNAP development kit for developing NAS apps")
+    (description "This package provides the QNAP development kit.")
+    (home-page "https://www.qnap.com/event/dev/en/p_qdk.php")
+    (license license:gpl2+)))