;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017 Eric Bavier ;;; Copyright © 2016, 2017, 2018 Efraim Flashner ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018 Rutger Helling ;;; ;;; 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
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2023 Justin Veilleux <terramorpha@cock.li>
;;;
;;; 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 syncthing)
  #:use-module (gnu packages syncthing)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (syncthing-configuration
            syncthing-configuration?
            syncthing-service-type))

;;; Commentary:
;;;
;;; This module provides a service definition for the syncthing service.
;;;
;;; Code:

(define-record-type* <syncthing-configuration>
  syncthing-configuration make-syncthing-configuration
  syncthing-configuration?
  (syncthing syncthing-configuration-syncthing ;file-like
             (default syncthing))
  (arguments syncthing-configuration-arguments ;list of strings
             (default '()))
  (logflags  syncthing-configuration-logflags  ;number
             (default 0))
  (user      syncthing-configuration-user      ;string
             (default #f))
  (group     syncthing-configuration-group     ;string
             (default "users"))
  (home      syncthing-configuration-home      ;string
             (default #f))
  (home-service? syncthing-configuration-home-service?
                 (default for-home?) (innate)))

(define syncthing-shepherd-service
  (match-record-lambda <syncthing-configuration>
      (syncthing arguments logflags user group home home-service?)
    (list
     (shepherd-service
      (provision (if home-service?
                     '(syncthing)
                     (list (string->symbol
                            (string-append "syncthing-" user)))))
      (documentation "Run syncthing.")
      (requirement (if home-service? '() '(loopback user-processes)))
      (start #~(make-forkexec-constructor
                (append (list (string-append #$syncthing "/bin/syncthing")
                              "--no-browser"
                              "--no-restart"
                              (string-append "--logflags=" (number->string #$logflags)))
                        '#$arguments)
                #:user #$(and (not home-service?) user)
                #:group #$(and (not home-service?) group)
                #:environment-variables
                (append
                 (list
                  (string-append "HOME="
                                 (or #$home
                                     (passwd:dir
                                      (getpw (if (and #$home-service?
                                                      (not #$user))
                                                 (getuid)
                                                 #$user)))))
                              "SSL_CERT_DIR=/etc/ssl/certs"
                              "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt")
                        (filter (negate       ;XXX: 'remove' is not in (guile)
                                 (lambda (str)
                                   (or (string-prefix? "HOME=" str)
                                       (string-prefix? "SSL_CERT_DIR=" str)
                                       (string-prefix? "SSL_CERT_FILE=" str))))
                                (environ)))))
      (respawn? #f)
      (stop #~(make-kill-destructor))))))

(define syncthing-service-type
  (service-type (name 'syncthing)
                (extensions (list (service-extension shepherd-root-service-type
                                                     syncthing-shepherd-service)))
                (description
                 "Run @uref{https://github.com/syncthing/syncthing, Syncthing}
decentralized continuous file system synchronization.")))

;;; syncthing.scm ends here
generated by cgit
BioNERO")))
(build-system r-build-system)
(propagated-inputs
generated by cgit
or the native target. (arguments `(#:modules ((srfi srfi-1) ,@%gnu-build-system-modules) ,@(substitute-keyword-arguments (package-arguments qemu-minimal) ((#:configure-flags config-flags) ``(,(string-append "--target-list=" ,machine "-linux-user") ,@(remove (λ (f) (string-prefix? "--target-list=" f)) ,config-flags))) ((#:phases qemu-phases) `(modify-phases ,qemu-phases (add-after 'unpack 'apply-afl-patches (lambda* (#:key inputs #:allow-other-keys) (let* ((afl-dir (string-append "afl-" ,version)) (patch-dir (string-append afl-dir "/qemu_mode/patches"))) (unless (zero? (system* "tar" "xf" (assoc-ref inputs "afl-src"))) (error "tar failed to unpack afl-src")) (install-file (string-append patch-dir "/afl-qemu-cpu-inl.h") ".") (copy-file (string-append afl-dir "/config.h") "./afl-config.h") (install-file (string-append afl-dir "/types.h") ".") (substitute* "afl-qemu-cpu-inl.h" (("\\.\\./\\.\\./config.h") "afl-config.h")) (substitute* (string-append patch-dir "/cpu-exec.diff") (("\\.\\./patches/") "")) (every (lambda (patch-file) (zero? (system* "patch" "--force" "-p1" "--input" patch-file))) (find-files patch-dir "\\.diff$")))))))))))))) (arguments `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")) "CC=gcc") #:phases (modify-phases %standard-phases (delete 'configure) ,@(if (string=? (%current-system) (or "x86_64-linux" "i686-linux")) '() '((add-before 'build 'set-afl-flag (lambda _ (setenv "AFL_NO_X86" "1") #t)) (add-after 'install 'remove-x86-programs (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin/"))) (delete-file (string-append bin "afl-gcc")) (delete-file (string-append bin "afl-g++")) (delete-file (string-append bin "afl-clang")) (delete-file (string-append bin "afl-clang++"))) #t)))) (add-after ;; TODO: Build and install the afl-llvm tool. 'install 'install-qemu (lambda* (#:key inputs outputs #:allow-other-keys) (let ((qemu (assoc-ref inputs "custom-qemu")) (out (assoc-ref outputs "out"))) (symlink (string-append qemu "/bin/qemu-" ,machine) (string-append out "/bin/afl-qemu-trace")) #t))) (delete 'check)))) ; Tests are run during 'install phase. (home-page "http://lcamtuf.coredump.cx/afl") (synopsis "Security-oriented fuzzer") (description "American fuzzy lop is a security-oriented fuzzer that employs a novel type of compile-time instrumentation and genetic algorithms to automatically discover clean, interesting test cases that trigger new internal states in the targeted binary. This substantially improves the functional coverage for the fuzzed code. The compact synthesized corpora produced by the tool are also useful for seeding other, more labor- or resource-intensive testing regimes down the road.") (license asl2.0)))) (define-public stress-make (let ((commit "506e6cfd98d165f22bee91c408b7c20117a682c4") (revision "0")) ;No official source distribution (package (name "stress-make") (version (string-append "1.0-" revision "." (string-take commit 7))) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/losalamos/stress-make.git") (commit commit))) (file-name (string-append name "-" version "-checkout")) (sha256 (base32 "1j330yqhc7plwin04qxbh8afpg5nfnw1xvnmh8rk6mmqg9w6ik70")))) (build-system gnu-build-system) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("go" ,go))) (inputs `(("make-source" ,(package-source gnu-make)))) (arguments ;; stress-make's configure script insists on having a tarball and does ;; not accept a directory name instead. To let the gnu-build-system's ;; patch-* phases work properly, we unpack the source first, then ;; repack before the configure phase. (let ((make-dir (string-append "make-" (package-version gnu-make)))) `(#:configure-flags '("--with-make-tar=./make.tar.xz") #:phases (modify-phases %standard-phases (add-after 'unpack 'unpack-make (lambda* (#:key inputs #:allow-other-keys) (zero? (system* "tar" "xf" (assoc-ref inputs "make-source"))))) (add-after 'unpack-make 'set-default-shell (lambda _ ;; Taken mostly directly from (@ (gnu packages base) gnu-make) (substitute* (string-append ,make-dir "/job.c") (("default_shell = .*$") (format #f "default_shell = \"~a\";\n" (which "sh")))))) (add-before 'configure 'repack-make (lambda _ (zero? (system* "tar" "cJf" "./make.tar.xz" ,make-dir)))))))) (home-page "https://github.com/losalamos/stress-make") (synopsis "Expose race conditions in Makefiles") (description "Stress Make is a customized GNU Make that explicitely manages the order in which concurrent jobs are run to provoke erroneous behavior into becoming manifest. It can run jobs in the order in which they're launched, in backwards order, or in random order. The thought is that if code builds correctly with Stress Make, then it is likely that the @code{Makefile} contains no race conditions.") ;; stress-make wrapper is under BSD-3-modifications-must-be-indicated, ;; and patched GNU Make is under its own license. (license (list (non-copyleft "COPYING.md") (package-license gnu-make)))))) (define-public zzuf (package (name "zzuf") (version "0.15") (source (origin (method url-fetch) (uri (string-append "https://github.com/samhocevar/zzuf/releases/download/v" version "/" name "-" version ".tar.gz")) (file-name (string-append name "-" version ".tar.gz")) (sha256 (base32 "1mpzjaksc2qg2hzqflf39pl06p53qam2dn3hkhkcv6p00d2n4kx3")))) (build-system gnu-build-system) (home-page "https://github.com/samhocevar/zzuf") (synopsis "Transparent application input fuzzer") (description "Zzuf is a transparent application input fuzzer. It works by intercepting file operations and changing random bits in the program's input. Zzuf's behaviour is deterministic, making it easy to reproduce bugs.") (license (non-copyleft "http://www.wtfpl.net/txt/copying/"))))