Merge branch 'master' into core-updates

This commit is contained in:
Marius Bakke 2018-11-29 15:56:49 +01:00
commit 25ca46985c
No known key found for this signature in database
GPG Key ID: A2A06DF2A33A54FA
61 changed files with 2240 additions and 383 deletions

View File

@ -75,6 +75,7 @@ MODULES = \
guix/discovery.scm \
guix/git-download.scm \
guix/hg-download.scm \
guix/swh.scm \
guix/monads.scm \
guix/monad-repl.scm \
guix/gexp.scm \
@ -611,6 +612,7 @@ guix-binary.%.tar.xz:
dist-hook: $(distdir)/ChangeLog gen-AUTHORS gen-tarball-version
dist-hook: assert-no-store-file-names
dist-hook: doc-po-update
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained

View File

@ -5060,7 +5060,7 @@ a derivation is the @code{derivation} procedure:
[#:system (%current-system)] [#:references-graphs #f] @
[#:allowed-references #f] [#:disallowed-references #f] @
[#:leaked-env-vars #f] [#:local-build? #f] @
[#:substitutable? #t]
[#:substitutable? #t] [#:properties '()]
Build a derivation with the given arguments, and return the resulting
@code{<derivation>} object.
@ -5097,6 +5097,9 @@ When @var{substitutable?} is false, declare that substitutes of the
derivation's output should not be used (@pxref{Substitutes}). This is
useful, for instance, when building packages that capture details of the
host CPU instruction set.
@var{properties} must be an association list describing ``properties'' of the
derivation. It is kept as-is, uninterpreted, in the derivation.
@end deffn
@noindent
@ -5790,7 +5793,8 @@ information about monads.)
[#:leaked-env-vars #f] @
[#:script-name (string-append @var{name} "-builder")] @
[#:deprecation-warnings #f] @
[#:local-build? #f] [#:substitutable? #t] [#:guile-for-build #f]
[#:local-build? #f] [#:substitutable? #t] @
[#:properties '()] [#:guile-for-build #f]
Return a derivation @var{name} that runs @var{exp} (a gexp) with
@var{guile-for-build} (a derivation) on @var{system}; @var{exp} is
stored in a file called @var{script-name}. When @var{target} is true,
@ -6229,6 +6233,10 @@ the end of the build log. This is useful when debugging build issues.
@xref{Debugging Build Failures}, for tips and tricks on how to debug
build issues.
This option has no effect when connecting to a remote daemon with a
@code{guix://} URI (@pxref{The Store, the @code{GUIX_DAEMON_SOCKET}
variable}).
@item --keep-going
@itemx -k
Keep going when some of the derivations fail to build; return only once
@ -9723,9 +9731,9 @@ environment variable---in addition to the per-user profiles
provides all the tools one would expect for basic user and administrator
tasks---including the GNU Core Utilities, the GNU Networking Utilities,
the GNU Zile lightweight text editor, @command{find}, @command{grep},
etc. The example above adds GNU@tie{}Screen and OpenSSH to those,
taken from the @code{(gnu packages screen)} and @code{(gnu packages ssh)}
modules (@pxref{Package Modules}). The
etc. The example above adds GNU@tie{}Screen to those,
taken from the @code{(gnu packages screen)}
module (@pxref{Package Modules}). The
@code{(list package output)} syntax can be used to add a specific output
of a package:

View File

@ -348,6 +348,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/perl-check.scm \
%D%/packages/perl-web.scm \
%D%/packages/photo.scm \
%D%/packages/phabricator.scm \
%D%/packages/php.scm \
%D%/packages/pkg-config.scm \
%D%/packages/plotutils.scm \
@ -738,6 +739,7 @@ dist_patch_DATA = \
%D%/packages/patches/geoclue-config.patch \
%D%/packages/patches/ghc-8.0-fall-back-to-madv_dontneed.patch \
%D%/packages/patches/ghc-dont-pass-linker-flags-via-response-files.patch \
%D%/packages/patches/ghc-haddock-library-unbundle.patch \
%D%/packages/patches/ghostscript-CVE-2018-16509.patch \
%D%/packages/patches/ghostscript-bug-699708.patch \
%D%/packages/patches/ghostscript-no-header-id.patch \
@ -897,6 +899,7 @@ dist_patch_DATA = \
%D%/packages/patches/libffi-3.2.1-complex-alpha.patch \
%D%/packages/patches/libjxr-fix-function-signature.patch \
%D%/packages/patches/libjxr-fix-typos.patch \
%D%/packages/patches/libopenshot-tests-with-system-libs.patch \
%D%/packages/patches/libotr-test-auth-fix.patch \
%D%/packages/patches/libmad-armv7-thumb-pt1.patch \
%D%/packages/patches/libmad-armv7-thumb-pt2.patch \
@ -1149,6 +1152,7 @@ dist_patch_DATA = \
%D%/packages/patches/scotch-build-parallelism.patch \
%D%/packages/patches/scotch-graph-diam-64.patch \
%D%/packages/patches/scotch-graph-induce-type-64.patch \
%D%/packages/patches/scribus-poppler.patch \
%D%/packages/patches/sdl-libx11-1.6.patch \
%D%/packages/patches/seq24-rename-mutex.patch \
%D%/packages/patches/sharutils-CVE-2018-1000097.patch \
@ -1251,6 +1255,7 @@ dist_patch_DATA = \
%D%/packages/patches/wpa-supplicant-fix-zeroed-keys.patch \
%D%/packages/patches/wpa-supplicant-fix-nonce-reuse.patch \
%D%/packages/patches/wpa-supplicant-krack-followups.patch \
%D%/packages/patches/x265-arm-flags.patch \
%D%/packages/patches/x265-detect512-all-arches.patch \
%D%/packages/patches/xboing-CVE-2004-0149.patch \
%D%/packages/patches/xf86-video-ark-remove-mibstore.patch \

View File

@ -16,6 +16,7 @@
;;; Copyright © 2018 Brett Gilio <brettg@posteo.net>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Thorsten Wilms <t_w_@freenet.de>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -3639,3 +3640,38 @@ library supports sample rates up to 96 kHz and up to eight channels (7.1
surround).")
(license (license:fsf-free "https://github.com/mstorsjo/fdk-aac/blob/master/NOTICE"
"https://www.gnu.org/licenses/license-list.html#fdk")))))
(define-public libopenshot-audio
(package
(name "libopenshot-audio")
(version "0.1.7")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/OpenShot/libopenshot-audio")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"08a8wbi28kwrdz4h0rs1b9vsr28ldfi8g75q54rj676y1vwg3qys"))))
(build-system cmake-build-system)
(inputs
`(("alsa-lib" ,alsa-lib)
;; The following are for JUCE GUI components:
("libx11" ,libx11)
("freetype" ,freetype)
("libxrandr" ,libxrandr)
("libxinerama" ,libxinerama)
("libxcursor" ,libxcursor)))
(arguments
`(#:tests? #f ;there are no tests
#:configure-flags
(list (string-append "-DCMAKE_CXX_FLAGS=-I"
(assoc-ref %build-inputs "freetype")
"/include/freetype2"))))
(home-page "https://openshot.org")
(synopsis "Audio editing and playback for OpenShot")
(description "OpenShot Audio Library (libopenshot-audio) allows
high-quality editing and playback of audio, and is based on the JUCE
library.")
(license license:lgpl3+)))

View File

@ -1030,3 +1030,41 @@ maps.")
"This package provides tools to parse Illumina Sequence Analysis
Viewer (SAV) files, access data, and generate QC plots.")
(license license:agpl3+)))
(define-public r-chipexoqual
(package
(name "r-chipexoqual")
(version "1.6.0")
(source
(origin
(method url-fetch)
(uri (bioconductor-uri "ChIPexoQual" version))
(sha256
(base32
"1773bpiybn4g9jlv46z29x19q4dpcvn7lairr3lq5pdqbqmz5hnp"))))
(properties `((upstream-name . "ChIPexoQual")))
(build-system r-build-system)
(propagated-inputs
`(("r-biocparallel" ,r-biocparallel)
("r-biovizbase" ,r-biovizbase)
("r-broom" ,r-broom)
("r-data-table" ,r-data-table)
("r-dplyr" ,r-dplyr)
("r-genomeinfodb" ,r-genomeinfodb)
("r-genomicalignments" ,r-genomicalignments)
("r-genomicranges" ,r-genomicranges)
("r-ggplot2" ,r-ggplot2)
("r-hexbin" ,r-hexbin)
("r-iranges" ,r-iranges)
("r-rcolorbrewer" ,r-rcolorbrewer)
("r-rmarkdown" ,r-rmarkdown)
("r-rsamtools" ,r-rsamtools)
("r-s4vectors" ,r-s4vectors)
("r-scales" ,r-scales)
("r-viridis" ,r-viridis)))
(home-page "https://github.com/keleslab/ChIPexoQual")
(synopsis "Quality control pipeline for ChIP-exo/nexus data")
(description
"This package provides a quality control pipeline for ChIP-exo/nexus
sequencing data.")
(license license:gpl2+)))

View File

@ -540,7 +540,7 @@ independent targets.")
(define-public uncrustify
(package
(name "uncrustify")
(version "0.67")
(version "0.68.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -548,10 +548,11 @@ independent targets.")
"uncrustify-" version ".zip"))
(sha256
(base32
"0n13kq0nsm35fxhdp0f275n4x0w88hdv3bdjy0hgvv42x0dx5zyp"))))
"1jb3hmm11m2mgnypapak2lgyyvspnmx9bxd9dxis5swaja2ddxlg"))))
(build-system cmake-build-system)
(native-inputs
`(("unzip" ,unzip)))
`(("unzip" ,unzip)
("python" ,python-wrapper)))
(arguments
`(#:phases
(modify-phases %standard-phases

View File

@ -1980,14 +1980,14 @@ can autogenerate peewee models using @code{pwiz}, a model generator.")
(define-public sqlcipher
(package
(name "sqlcipher")
(version "3.3.1")
(version "3.4.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/sqlcipher/" name
"/archive/v" version ".tar.gz"))
(sha256
(base32 "1gv58dlbpzrmznly52yqbxgvii0ib88zr3aszla1bsypwjr6flff"))
(base32 "1nxarwbci8jx99f1d0y1ivxcv25s78l1p7q6qy28lkpkcx8pm2b9"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs

View File

@ -95,14 +95,14 @@ Executable and Linkable Format (@dfn{ELF}). This includes @command{ld},
(package
(name "libabigail")
(home-page "https://sourceware.org/libabigail/")
(version "1.4")
(version "1.5")
(source (origin
(method url-fetch)
(uri (string-append "https://sourceware.org/pub/" name
"/" name "-" version ".tar.gz"))
(sha256
(base32
"17r8i60lxykvdd9pdidmnvkzgf9k8zman0c1czl3zbx0znhlx497"))))
"0srfnkbm386sl2n85686nl28da6ksbs7jgnfks9k0n61c772aas4"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--disable-static"

View File

@ -1474,14 +1474,22 @@ current match, total matches and exit status.
(name "emacs-go-mode")
(version "1.5.0")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/dominikh/go-mode.el/"
"archive/v" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/dominikh/go-mode.el.git")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1adngbjyb8qnwg7n6r2y31djw9j6qf3b9fi63zd85035q7x4ljnm"))))
"1nd2h50yb0493wvf1h7fzplq45rmqn2w7kxpgnlxzhkvq99v8vzf"))))
(build-system emacs-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'make-writable
(lambda _
(for-each make-file-writable (find-files "." "\\.el$"))
#t)))))
(home-page "https://github.com/dominikh/go-mode.el")
(synopsis "Go mode for Emacs")
(description
@ -2773,7 +2781,7 @@ build jobs.")
(define-public emacs-company
(package
(name "emacs-company")
(version "0.9.6")
(version "0.9.7")
(source
(origin
(method url-fetch)
@ -2782,7 +2790,7 @@ build jobs.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0a7zvmfvxh9w67myvcj2511ayk0fvkm06cdg38y8khnsx63jrr4k"))))
"19flv38f2qhxda8lbk2ckywvibd72vbzmn4hchqz6d8acsknh4sb"))))
(build-system emacs-build-system)
(arguments
`(#:phases
@ -2850,6 +2858,28 @@ described on the homepage.")
(build-system cmake-build-system)
(synopsis "Server for the Emacs @dfn{irony mode}")))
(define-public emacs-company-irony
(package
(name "emacs-company-irony")
(version "1.1.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/Sarcasm/company-irony.git")
(commit (string-append "v" version))))
(sha256 (base32
"1qgyam2vyjw90kpxns5cd6bq3qiqjhzpwrlvmi18vyb69qcgqd8a"))
(file-name (git-file-name name version))))
(build-system emacs-build-system)
(inputs
`(("emacs-irony-mode" ,emacs-irony-mode)
("emacs-company" ,emacs-company)))
(synopsis "C++ completion backend for Company using irony-mode")
(description "This backend for company-mode allows for C++ code completion
with irony-mode using clang-tooling.")
(home-page "https://github.com/Sarcasm/company-irony")
(license license:gpl3+)))
(define-public emacs-company-quickhelp
(package
(name "emacs-company-quickhelp")
@ -3393,7 +3423,7 @@ organizer.")
(define-public emacs-zenburn-theme
(package
(name "emacs-zenburn-theme")
(version "2.5")
(version "2.6")
(source (origin
(method url-fetch)
(uri (string-append
@ -3402,7 +3432,7 @@ organizer.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03kfhzgbbbl8ivpzzky6qxw4j9mmp452m1sk7wikxmcalfnix0gn"))))
"0qc9d1rwq55yzh8shbppyd6izy1grpyr8kqh5zdgm7c5jccngpr4"))))
(build-system emacs-build-system)
(home-page "https://github.com/bbatsov/zenburn-emacs")
(synopsis "Low contrast color theme for Emacs")
@ -3850,10 +3880,11 @@ expression.")
(license license:gpl3+)))
(define-public emacs-ivy-yasnippet
(let ((commit "59b32cf8cfb63df906822a17f6f5e8545dac38d4"))
(let ((commit "32580b4fd23ebf9ca7dde96704f7d53df6e253cd")
(revision "2"))
(package
(name "emacs-ivy-yasnippet")
(version (git-version "0.1" "1" commit))
(version (git-version "0.1" revision commit))
(source
(origin
(method git-fetch)
@ -3863,7 +3894,7 @@ expression.")
(file-name (git-file-name name version))
(sha256
(base32
"0hghdlxkfwrglvc1nql2ikgp6jj0qdbfwc3yvpb19mrf26hwgp13"))))
"1wfg6mmd5gl1qgvayyzpxlkh9s7jgn20y8l1vh1zbj1czvv51xp8"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-ivy" ,emacs-ivy)
@ -7784,24 +7815,25 @@ through them using @key{C-c C-SPC}.")
(license license:gpl3+)))
(define-public emacs-slack
(let ((commit "d90395482d26175ce38fd935e978c428be8af9a0")
(revision "4"))
(let ((commit "99a57501629a0329a9ca090c1ea1296462eda02d")
(revision "5"))
(package
(name "emacs-slack")
(version (string-append "0-" revision "." (string-take commit 7)))
(version (git-version "0.0.2" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/yuya373/emacs-slack.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(file-name (git-file-name name commit))
(sha256
(base32
"14f6wjcbl09cfd3yngr6m1k1d4nr764im666mbnqbk9nmqf50nib"))))
"0jw1diypfw8pmzkq0napgxmfc0gqka7zcccgnw359604lr30k2z2"))))
(build-system emacs-build-system)
(propagated-inputs
`(("emacs-alert" ,emacs-alert)
("emacs-emojify" ,emacs-emojify)
("emacs-helm" ,emacs-helm)
("emacs-request" ,emacs-request)
("emacs-websocket" ,emacs-websocket)
("emacs-oauth2" ,emacs-oauth2)
@ -7916,21 +7948,18 @@ contexts.
(license license:gpl3+)))
(define-public emacs-polymode
;; There hasn't been a proper release.
(let ((commit "0340f5e7e55235832e59673f027cc79a23cbdcd6")
(revision "1"))
(package
(name "emacs-polymode")
(version (string-append "1.0-" revision "." (string-take commit 7)))
(version "0.1.5")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/vspinu/polymode.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"057cybkq3cy07n5s332k071sjiky3mziy003lza4rh75mgqkwhmh"))))
"0wwphs54jx48a3ca6x1qaz56j3j9bg4mv8g2akkffrzbdcb8sbc7"))))
(build-system emacs-build-system)
(arguments
`(#:include (cons* "^modes/.*\\.el$" %default-include)
@ -7948,7 +7977,7 @@ for multiple major modes inside a single Emacs buffer. It is lightweight,
object oriented and highly extensible. Creating a new polymode typically
takes only a few lines of code. Polymode also provides extensible facilities
for external literate programming tools for exporting, weaving and tangling.")
(license license:gpl3+))))
(license license:gpl3+)))
(define-public eless
(package
@ -12535,43 +12564,6 @@ correctly.")
@end itemize\n")
(license license:gpl3+))))
(define-public emacs-clang-format
(let ((commit "5556c31528af2661bed3011bd63ffc0ed44e18a0"))
(package
(name "emacs-clang-format")
(version (git-version "0.0.0" "1" commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/emacsorphanage/clang-format")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"0ynvnp3vrcpngmwakb23xv4xn7jbkg43s196q7pg9nkl13x4n2nq"))))
(build-system emacs-build-system)
(inputs
`(("clang" ,clang)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'configure
(lambda* (#:key inputs #:allow-other-keys)
(let ((clang (assoc-ref inputs "clang")))
;; Repo is read-only.
(chmod "clang-format.el" #o644)
(emacs-substitute-variables "clang-format.el"
("clang-format-executable"
(string-append clang "/bin/clang-format"))))
#t)))))
(home-page "https://github.com/emacsorphanage/clang-format")
(synopsis "Format code using clang-format")
(description "This package allows to filter code through clang-format to
fix its formatting. @command{clang-format} is a tool that formats C/C++/Obj-C
code according to a set of style options, see
@url{http://clang.llvm.org/docs/ClangFormatStyleOptions.html}.")
(license license:gpl3+))))
(define-public emacs-gtk-look
(package
(name "emacs-gtk-look")

View File

@ -58,7 +58,8 @@
#:use-module (gnu packages tls)
#:use-module (gnu packages video)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg))
#:use-module (gnu packages xorg)
#:use-module (ice-9 match))
(define-public efl
(package
@ -139,12 +140,16 @@
(arguments
`(#:configure-flags '("--disable-silent-rules"
"--disable-systemd"
"--with-profile=release"
"--enable-liblz4"
"--enable-xinput22"
"--enable-image-loader-webp"
"--enable-multisense"
"--with-opengl=es"
"--enable-egl"
,@(match (%current-system)
("armhf-linux"
'("--with-opengl=es" "--with-egl"))
(_
'("--with-opengl=full")))
"--enable-harfbuzz"
;; for wayland
"--enable-wayland"

View File

@ -2053,8 +2053,8 @@ convenient nested tree operations.")
(license license:gpl3+)))
(define-public guile-simple-zmq
(let ((commit "5bb66a0499f94006cfd18b58e80ad6623f911c31")
(revision "2"))
(let ((commit "68bedb6679716214fb9d3472da57544526f7a618")
(revision "3"))
(package
(name "guile-simple-zmq")
(version (git-version "0.0.0" revision commit))
@ -2066,7 +2066,7 @@ convenient nested tree operations.")
(commit commit)))
(sha256
(base32
"0dj1brjqa7m4k71sf94aq26ca0la3nr894kfmjnqkpawqfp4dyaz"))
"1ad3xg69qqviy1f6dnlw0ysmfdbmp1jq65rfqb8nfd8dsrq2syli"))
(file-name (git-file-name name version))))
(build-system guile-build-system)
(arguments

View File

@ -268,7 +268,7 @@ alternatives. In compilers, this can reduce the cascade of secondary errors.")
(define-public kodi
(package
(name "kodi")
(version "18.0b5")
(version "18.0rc1")
(source (origin
(method git-fetch)
(uri (git-reference
@ -277,7 +277,7 @@ alternatives. In compilers, this can reduce the cascade of secondary errors.")
(file-name (git-file-name name version))
(sha256
(base32
"042qzvhys3sajby6ywgmrsymhji37qk0iqgppznrvm53vrizwsam"))
"0xzzp4x8l0ywx8aq93a1323il6wwslmgdbhasv0r8zp3w1c0wqf1"))
(snippet
'(begin
(use-modules (guix build utils))

View File

@ -400,8 +400,8 @@ It has been modified to remove all non-free binary blobs.")
;; supports qemu "virt" machine and possibly a large number of ARM boards.
;; See : https://wiki.debian.org/DebianKernel/ARMMP.
(define %linux-libre-version "4.19.4")
(define %linux-libre-hash "0m5k14a89bf5avr3kdh3909qjfnd051fbsb0v7a52d54dkg2nbp6")
(define %linux-libre-version "4.19.5")
(define %linux-libre-hash "1ailss05c3p9aw2ysv75kj9j7qk04rc0cn9y9dk6fmjhnbnw9abm")
(define %linux-libre-4.19-patches
(list %boot-logo-patch
@ -412,7 +412,7 @@ It has been modified to remove all non-free binary blobs.")
"/raw/34a7d9011fcfcfa38b68282fd2b1a8797e6834f0"
"/debian/patches/bugfix/arm/"
"arm-mm-export-__sync_icache_dcache-for-xen-privcmd.patch"))
(file-name "linux-libre-4.18-arm-export-__sync_icache_dcache.patch")
(file-name "linux-libre-4.19-arm-export-__sync_icache_dcache.patch")
(sha256
(base32 "1ifnfhpakzffn4b8n7x7w5cps9mzjxlkcfz9zqak2vaw8nzvl39f")))))
@ -423,8 +423,8 @@ It has been modified to remove all non-free binary blobs.")
#:patches %linux-libre-4.19-patches
#:configuration-file kernel-config))
(define %linux-libre-4.14-version "4.14.83")
(define %linux-libre-4.14-hash "0x6r09bqdrcqigyjx922vji3pdv36l24pl0j33xs8b7xawkvii9g")
(define %linux-libre-4.14-version "4.14.84")
(define %linux-libre-4.14-hash "0mdf436bxlrsv0jbnzwd5bblpavv9vk5qx7h2x55jp0iy9pvp3n2")
(define-public linux-libre-4.14
(make-linux-libre %linux-libre-4.14-version
@ -433,14 +433,14 @@ It has been modified to remove all non-free binary blobs.")
#:configuration-file kernel-config))
(define-public linux-libre-4.9
(make-linux-libre "4.9.140"
"12amh7m0khjx5q3bcv8sq59xkanaxa5xnw4m1iql7503nk4pgg9a"
(make-linux-libre "4.9.141"
"1cjyni2wf1m9l8nvfl4gcswxlk9rwhpr0q3lvhnlg20761kvixp4"
%intel-compatible-systems
#:configuration-file kernel-config))
(define-public linux-libre-4.4
(make-linux-libre "4.4.164"
"04w4x97bkd2javjws9pzv1shfcrhyn4nf9w8b6qk6zdaj45fzasb"
(make-linux-libre "4.4.165"
"1adpj8hbly5z3j7mlnydnm2kx2isi3194n1hszzwxki8gj0xnqk4"
%intel-compatible-systems
#:configuration-file kernel-config))

View File

@ -333,7 +333,6 @@ an interpreter, a compiler, a debugger, and much more.")
#t))))
(build-system gnu-build-system)
(outputs '("out" "doc"))
;; Bootstrap with CLISP.
(native-inputs
;; From INSTALL:
;; Supported build hosts are:
@ -343,15 +342,20 @@ an interpreter, a compiler, a debugger, and much more.")
;; ABCL (recent versions only)
;; CLISP (only some versions: 2.44.1 is OK, 2.47 is not)
;; XCL
;; CCL seems ideal then.
`(("ccl" ,ccl)
;; CCL seems ideal then, but it unfortunately only builds reliably
;; on some architectures.
`(,@(match (%current-system)
((or "x86_64-linux" "i686-linux")
`(("ccl" ,ccl)))
(_
`(("clisp" ,clisp))))
("which" ,which)
("inetutils" ,inetutils) ;for hostname(1)
("ed" ,ed)
("texlive" ,(texlive-union (list texlive-tex-texinfo)))
("texinfo" ,texinfo)))
(arguments
'(#:modules ((guix build gnu-build-system)
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(srfi srfi-1))
#:phases
@ -410,7 +414,11 @@ an interpreter, a compiler, a debugger, and much more.")
(replace 'build
(lambda* (#:key outputs #:allow-other-keys)
(setenv "CC" "gcc")
(invoke "sh" "make.sh" "ccl"
(invoke "sh" "make.sh" ,@(match (%current-system)
((or "x86_64-linux" "i686-linux")
`("ccl"))
(_
`("clisp")))
(string-append "--prefix="
(assoc-ref outputs "out")))))
(replace 'install
@ -3494,3 +3502,242 @@ Lisp, featuring:
(define-public ecl-lparallel
(sbcl-package->ecl-package sbcl-lparallel))
(define-public sbcl-cl-markup
(let ((commit "e0eb7debf4bdff98d1f49d0f811321a6a637b390"))
(package
(name "sbcl-cl-markup")
(version (git-version "0.1" "1" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/arielnetworks/cl-markup/")
(commit commit)))
(file-name (git-file-name "cl-markup" version))
(sha256
(base32
"10l6k45971dl13fkdmva7zc6i453lmq9j4xax2ci6pjzlc6xjhp7"))))
(build-system asdf-build-system/sbcl)
(home-page "https://github.com/arielnetworks/cl-markup/")
(synopsis "Markup generation library for Common Lisp")
(description
"A modern markup generation library for Common Lisp that features:
@itemize
@item Fast (even faster through compiling the code)
@item Safety
@item Support for multiple document types (markup, xml, html, html5, xhtml)
@item Output with doctype
@item Direct output to stream
@end itemize\n")
(license license:lgpl3+))))
(define-public cl-markup
(sbcl-package->cl-source-package sbcl-cl-markup))
(define-public ecl-cl-markup
(sbcl-package->ecl-package sbcl-cl-markup))
(define-public sbcl-cl-css
(let ((commit "8fe654c8f0cf95b300718101cce4feb517f78e2f"))
(package
(name "sbcl-cl-css")
(version (git-version "0.1" "1" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/inaimathi/cl-css/")
(commit commit)))
(file-name (git-file-name "cl-css" version))
(sha256
(base32
"1lc42zi2sw11fl2589sc19nr5sd2p0wy7wgvgwaggxa5f3ajhsmd"))))
(build-system asdf-build-system/sbcl)
(home-page "https://github.com/inaimathi/cl-css/")
(synopsis "Non-validating, inline CSS generator for Common Lisp")
(description
"This is a dead-simple, non validating, inline CSS generator for Common
Lisp. Its goals are axiomatic syntax, simple implementation to support
portability, and boilerplate reduction in CSS.")
(license license:expat))))
(define-public cl-css
(sbcl-package->cl-source-package sbcl-cl-css))
(define-public ecl-cl-markup
(sbcl-package->ecl-package sbcl-cl-css))
(define-public sbcl-portable-threads
(let ((commit "c0e61a1faeb0583c80fd3f20b16cc4c555226920"))
(package
(name "sbcl-portable-threads")
(version (git-version "2.3" "1" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/binghe/portable-threads/")
(commit commit)))
(file-name (git-file-name "portable-threads" version))
(sha256
(base32
"03fmxyarc0xf4kavwkfa0a2spkyfrz6hbgbi9y4q7ny5aykdyfaq"))))
(build-system asdf-build-system/sbcl)
(arguments
`(;; Tests seem broken.
#:tests? #f))
(home-page "https://github.com/binghe/portable-threads")
(synopsis "Portable threads (and scheduled and periodic functions) API for Common Lisp")
(description
"Portable Threads (and Scheduled and Periodic Functions) API for Common
Lisp (from GBBopen project).")
(license license:asl2.0))))
(define-public cl-portable-threads
(sbcl-package->cl-source-package sbcl-portable-threads))
(define-public ecl-portable-threada
(sbcl-package->ecl-package sbcl-portable-threads))
(define-public sbcl-usocket-boot0
;; usocket's test rely on usocket-server which depends on usocket itself.
;; We break this cyclic dependency with -boot0 that packages usocket.
(let ((commit "86e7efbfe50101931edf4b67cdcfa7e221ecfde9"))
(package
(name "sbcl-usocket-boot0")
(version (git-version "0.7.1" "1" commit))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/usocket/usocket/")
(commit commit)))
(file-name (git-file-name "usocket" version))
(sha256
(base32
"1lk6ipakrib7kdgzw44hrgmls9akp5pz4h35yynw0k5zwmmq6374"))))
(build-system asdf-build-system/sbcl)
(inputs
`(("split-sequence" ,sbcl-split-sequence)))
(arguments
`(#:tests? #f
#:asd-system-name "usocket"))
(home-page "https://common-lisp.net/project/usocket/")
(synopsis "Universal socket library for Common Lisp (server side)")
(description
"This library strives to provide a portable TCP/IP and UDP/IP socket
interface for as many Common Lisp implementations as possible, while keeping
the abstraction and portability layer as thin as possible.")
(license license:expat))))
(define-public sbcl-usocket-server
(package
(inherit sbcl-usocket-boot0)
(name "sbcl-usocket-server")
(inputs
`(("usocket" ,sbcl-usocket-boot0)
("portable-threads" ,sbcl-portable-threads)))
(arguments
'(#:asd-system-name "usocket-server"))
(synopsis "Universal socket library for Common Lisp (server side)")))
(define-public cl-usocket-server
(sbcl-package->cl-source-package sbcl-usocket-server))
(define-public ecl-socket-server
(sbcl-package->ecl-package sbcl-usocket-server))
(define-public sbcl-usocket
(package
(inherit sbcl-usocket-boot0)
(name "sbcl-usocket")
(arguments
;; FIXME: Tests need network access?
`(#:tests? #f))
(native-inputs
;; Testing only.
`(("usocket-server" ,sbcl-usocket-server)
("rt" ,sbcl-rt)))))
(define-public cl-usocket
(sbcl-package->cl-source-package sbcl-usocket))
(define-public ecl-socket
(sbcl-package->ecl-package sbcl-usocket))
(define-public sbcl-s-xml
(package
(name "sbcl-s-xml")
(version "3")
(source
(origin
(method url-fetch)
(uri "https://common-lisp.net/project/s-xml/s-xml.tgz")
(sha256
(base32
"061qcr0dzshsa38s5ma4ay924cwak2nq9gy59dw6v9p0qb58nzjf"))))
(build-system asdf-build-system/sbcl)
(home-page "https://common-lisp.net/project/s-xml/")
(synopsis "Simple XML parser implemented in Common Lisp")
(description
"S-XML is a simple XML parser implemented in Common Lisp. This XML
parser implementation has the following features:
@itemize
@item It works (handling many common XML usages).
@item It is very small (the core is about 700 lines of code, including
comments and whitespace).
@item It has a core API that is simple, efficient and pure functional, much
like that from SSAX (see also http://ssax.sourceforge.net).
@item It supports different DOM models: an XSML-based one, an LXML-based one
and a classic xml-element struct based one.
@item It is reasonably time and space efficient (internally avoiding garbage
generatation as much as possible).
@item It does support CDATA.
@item It should support the same character sets as your Common Lisp
implementation.
@item It does support XML name spaces.
@end itemize
This XML parser implementation has the following limitations:
@itemize
@item It does not support any special tags (like processing instructions).
@item It is not validating, even skips DTD's all together.
@end itemize\n")
(license license:lgpl3+)))
(define-public cl-s-xml
(sbcl-package->cl-source-package sbcl-s-xml))
(define-public ecl-s-xml
(sbcl-package->ecl-package sbcl-s-xml))
(define-public sbcl-s-xml-rpc
(package
(name "sbcl-s-xml-rpc")
(version "7")
(source
(origin
(method url-fetch)
(uri "https://common-lisp.net/project/s-xml-rpc/s-xml-rpc.tgz")
(sha256
(base32
"02z7k163d51v0pzk8mn1xb6h5s6x64gjqkslhwm3a5x26k2gfs11"))))
(build-system asdf-build-system/sbcl)
(inputs
`(("s-xml" ,sbcl-s-xml)))
(home-page "https://common-lisp.net/project/s-xml-rpc/")
(synopsis "Implementation of XML-RPC in Common Lisp for both client and server")
(description
"S-XML-RPC is an implementation of XML-RPC in Common Lisp for both
client and server.")
(license license:lgpl3+)))
(define-public cl-s-xml-rpc
(sbcl-package->cl-source-package sbcl-s-xml-rpc))
(define-public ecl-s-xml-rpc
(sbcl-package->ecl-package sbcl-s-xml-rpc))

View File

@ -8,6 +8,8 @@
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2018 Pierre Neidhardt <mail@ambrevar.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@ -31,6 +33,7 @@
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (guix build-system emacs)
#:use-module (guix build-system python)
#:use-module (gnu packages)
#:use-module (gnu packages gcc)
@ -233,7 +236,30 @@ compiler. In LLVM this library is called \"compiler-rt\".")
(substitute* "lib/Driver/ToolChains.cpp"
(("@GLIBC_LIBDIR@")
(string-append libc "/lib")))))
#t))))))
#t)))
(add-after 'install 'install-clean-up-/share/clang
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(compl-dir (string-append
out "/etc/bash_completion.d")))
(with-directory-excursion (string-append out
"/share/clang")
(for-each
(lambda (file)
(when (file-exists? file)
(delete-file file)))
;; Delete extensions for proprietary text editors.
'("clang-format-bbedit.applescript"
"clang-format-sublime.py"
;; Delete Emacs extensions: see their respective Emacs
;; Guix package instead.
"clang-rename.el" "clang-format.el"))
;; Install bash completion.
(when (file-exists? "bash-autocomplete.sh")
(mkdir-p compl-dir)
(rename-file "bash-autocomplete.sh"
(string-append compl-dir "/clang")))))
#t)))))
;; Clang supports the same environment variables as GCC.
(native-search-paths
@ -437,3 +463,49 @@ code analysis tools.")
(description
"This package provides a Python binding to LLVM for use in Numba.")
(license license:bsd-3)))
(define-public emacs-clang-format
(package
(inherit clang)
(name "emacs-clang-format")
(build-system emacs-build-system)
(inputs
`(("clang" ,clang)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'configure
(lambda* (#:key inputs #:allow-other-keys)
(let ((clang (assoc-ref inputs "clang")))
(copy-file "tools/clang-format/clang-format.el" "clang-format.el")
(emacs-substitute-variables "clang-format.el"
("clang-format-executable"
(string-append clang "/bin/clang-format"))))
#t)))))
(synopsis "Format code using clang-format")
(description "This package allows to filter code through @code{clang-format}
to fix its formatting. @code{clang-format} is a tool that formats
C/C++/Obj-C code according to a set of style options, see
@url{http://clang.llvm.org/docs/ClangFormatStyleOptions.html}.")))
(define-public emacs-clang-rename
(package
(inherit clang)
(name "emacs-clang-rename")
(build-system emacs-build-system)
(inputs
`(("clang" ,clang)))
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'configure
(lambda* (#:key inputs #:allow-other-keys)
(let ((clang (assoc-ref inputs "clang")))
(copy-file "tools/clang-rename/clang-rename.el" "clang-rename.el")
(emacs-substitute-variables "clang-rename.el"
("clang-rename-binary"
(string-append clang "/bin/clang-rename"))))
#t)))))
(synopsis "Rename every occurrence of a symbol using clang-rename")
(description "This package renames every occurrence of a symbol at point
using @code{clang-rename}.")))

View File

@ -9,6 +9,7 @@
;;; Copyright © 2018 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2018 Fis Trivial <ybbs.daans@hotmail.com>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2018 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -331,8 +332,8 @@ algorithm.")
(origin
(method url-fetch)
(uri (string-append
"http://www.imbs-luebeck.de/imbs/sites/default/files/u59/"
"randomjungle-" version ".tar_.gz"))
"https://www.imbs.uni-luebeck.de/fileadmin/files/Software"
"/randomjungle/randomjungle-" version ".tar_.gz"))
(patches (search-patches "randomjungle-disable-static-build.patch"))
(sha256
(base32
@ -361,7 +362,7 @@ algorithm.")
;; Non-portable assembly instructions are used so building fails on
;; platforms other than x86_64 or i686.
(supported-systems '("x86_64-linux" "i686-linux"))
(home-page "http://www.imbs-luebeck.de/imbs/de/node/227/")
(home-page "https://www.imbs.uni-luebeck.de/forschung/software/details.html#c224")
(synopsis "Implementation of the Random Forests machine learning method")
(description
"Random Jungle is an implementation of Random Forests. It is supposed to

View File

@ -257,14 +257,14 @@ aliasing facilities to work just as they would on normal mail.")
(define-public mutt
(package
(name "mutt")
(version "1.10.1")
(version "1.11.0")
(source (origin
(method url-fetch)
(uri (string-append "https://bitbucket.org/mutt/mutt/downloads/"
"mutt-" version ".tar.gz"))
(sha256
(base32
"182lkbkpd3q3l1x6bvyds90ycp38gyyxhf35ry0d3hwf2n1khjkk"))
"1qqhkhlzvjj0iih8vm0wfagv4fzqqy1wnsb4sqsfv7w06ccjdjcj"))
(patches (search-patches "mutt-store-references.patch"))))
(build-system gnu-build-system)
(inputs
@ -1202,7 +1202,7 @@ facilities for checking incoming mail.")
(define-public dovecot
(package
(name "dovecot")
(version "2.3.2.1")
(version "2.3.4")
(source
(origin
(method url-fetch)
@ -1210,7 +1210,7 @@ facilities for checking incoming mail.")
(version-major+minor version) "/"
name "-" version ".tar.gz"))
(sha256 (base32
"0d2ffbicgl3wswbnyjbw6qigz7r1aqzprpchbwp5cynw122i2raa"))))
"01ggzf7b3jpl89mjiqr7xbpbs181g2gjf6wzg70qaqfzz3ppc6yr"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

View File

@ -2750,7 +2750,7 @@ to BMP, JPEG or PNG image formats.")
(define-public maxima
(package
(name "maxima")
(version "5.42.0")
(version "5.42.1")
(source
(origin
(method url-fetch)
@ -2758,7 +2758,7 @@ to BMP, JPEG or PNG image formats.")
version "-source/" name "-" version ".tar.gz"))
(sha256
(base32
"0d5pdihvcbwb7r4i4qs5qqgsz46hxlq33qj8is053llrgn9ylpyn"))
"1ka0xf70a55ndgmyrq7p5xxbd78pq7bfkqhgxsivaqdw6gn5lmcg"))
(patches (search-patches "maxima-defsystem-mkdir.patch"))))
(build-system gnu-build-system)
(inputs
@ -2849,16 +2849,17 @@ point numbers.")
(define-public wxmaxima
(package
(name "wxmaxima")
(version "18.10.1")
(version "18.11.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/wxMaxima-developers/" name
"/archive/Version-" version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(method git-fetch)
(uri (git-reference
(url "https://github.com/wxMaxima-developers/wxmaxima.git")
(commit (string-append "Version-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"0c2blq65r0am509p3rjqpwqk6vl5r2yg1p9nh2jczf80vhi3ldas"))))
"1sz8n9v23q442l7yjj67pjh0dk78rl4cbcc3j8m1bm88anlfxl9r"))))
(build-system cmake-build-system)
(native-inputs
`(("gettext" ,gettext-minimal)))

View File

@ -28,7 +28,7 @@
(define-public mtools
(package
(name "mtools")
(version "4.0.20")
(version "4.0.21")
(source
(origin
(method url-fetch)
@ -36,7 +36,7 @@
version ".tar.bz2"))
(sha256
(base32
"1vcahr9s6zv1hnrx2bgjnzcas2y951q90r1jvvv4q9v5kwfd6qb0"))))
"1kybydx74qgbwpnjvjn49msf8zipchl43d4cq8zzwcyvfkdzw7h2"))))
(build-system gnu-build-system)
(home-page "https://www.gnu.org/software/mtools/")
(synopsis "Access MS-DOS disks without mounting")

View File

@ -59,6 +59,7 @@
#:use-module (gnu packages time)
#:use-module (gnu packages tls)
#:use-module (gnu packages version-control)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages web-browsers)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
@ -328,7 +329,7 @@ functional, imperative and object-oriented styles of programming.")
(define-public opam
(package
(name "opam")
(version "2.0.0")
(version "2.0.1")
(source (origin
(method url-fetch)
;; Use the '-full' version, which includes all the dependencies.
@ -340,7 +341,7 @@ functional, imperative and object-oriented styles of programming.")
)
(sha256
(base32
"09gdpxiqmyr6z78l85d7pwhiwrycdi2xi1b2mafqr1sk9z5lzbcx"))))
"0z6r9qr4awcdn7wyrl5y5jm34jsjlnzd00py893f1hd0c6vg3xw1"))))
(build-system gnu-build-system)
(arguments
'(;; Sometimes, 'make -jX' would fail right after ./configure with
@ -361,17 +362,29 @@ functional, imperative and object-oriented styles of programming.")
#:phases (modify-phases %standard-phases
(add-before 'build 'pre-build
(lambda* (#:key inputs make-flags #:allow-other-keys)
(let ((bash (assoc-ref inputs "bash")))
(let ((bash (assoc-ref inputs "bash"))
(bwrap (string-append (assoc-ref inputs "bubblewrap")
"/bin/bwrap")))
(substitute* "src/core/opamSystem.ml"
(("\"/bin/sh\"")
(string-append "\"" bash "/bin/sh\"")))
(string-append "\"" bash "/bin/sh\""))
(("getconf")
(which "getconf")))
;; Use bwrap from the store directly.
(substitute* "src/state/shellscripts/bwrap.sh"
(("-v bwrap") (string-append "-v " bwrap))
(("exec bwrap") (string-append "exec " bwrap)))
(substitute* "src/client/opamInitDefaults.ml"
(("\"bwrap\"") (string-append "\"" bwrap "\"")))
;; Build dependencies
(zero? (apply system* "make" "lib-ext" make-flags)))))
(apply invoke "make" "lib-ext" make-flags)
#t)))
(add-before 'check 'pre-check
(lambda _
(setenv "HOME" (getcwd))
(and (system "git config --global user.email guix@gnu.org")
(system "git config --global user.name Guix")))))))
(invoke "git" "config" "--global" "user.email" "guix@gnu.org")
(invoke "git" "config" "--global" "user.name" "Guix")
#t)))))
(native-inputs
`(("git" ,git) ;for the tests
("python" ,python) ;for the tests
@ -379,7 +392,8 @@ functional, imperative and object-oriented styles of programming.")
(inputs
`(("ocaml" ,ocaml)
("ncurses" ,ncurses)
("curl" ,curl)))
("curl" ,curl)
("bubblewrap" ,bubblewrap)))
(home-page "http://opam.ocamlpro.com/")
(synopsis "Package manager for OCaml")
(description

View File

@ -102,8 +102,8 @@
;; Note: the 'update-guix-package.scm' script expects this definition to
;; start precisely like this.
(let ((version "0.15.0")
(commit "f5a2724ae453f4a4b55ff848f4ad7e30efb6eef8")
(revision 7))
(commit "71a78ba65b00ad1f27086a3dcdded7dc4326ade1")
(revision 8))
(package
(name "guix")
@ -119,7 +119,7 @@
(commit commit)))
(sha256
(base32
"12glmvifbwvl6lmxh1mc8nbcp0f5qgw40rmf8n1icxvj0mnjrwp4"))
"0isagzccfxjqrc38wamknvh0jzv1pjh0wq5baj9jzwl07xkrc0hc"))
(file-name (string-append "guix-" version "-checkout"))))
(build-system gnu-build-system)
(arguments
@ -343,8 +343,7 @@ the Nix package manager.")
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(invoke "make" "install-binPROGRAMS"
"install-nodist_pkglibexecSCRIPTS"
"install-nodist_libexecSCRIPTS") ;guix-authenticate
"install-nodist_pkglibexecSCRIPTS")
;; We need to tell 'guix-daemon' which 'guix' command to use.
;; Here we use a questionable hack where we hard-code root's

View File

@ -48,7 +48,7 @@
(define-public parallel
(package
(name "parallel")
(version "20181022")
(version "20181122")
(source
(origin
(method url-fetch)
@ -56,7 +56,7 @@
version ".tar.bz2"))
(sha256
(base32
"1v6vrfnn6acjjlp8xiizvcrb3zzs94av5xcl6xm8zfvcapixx11f"))))
"1mcqymf6vg8jhnjv71sswcz5xrwpq2h2ishi8m1hz8rwhc65h1ig"))))
(build-system gnu-build-system)
(arguments
`(#:phases

View File

@ -0,0 +1,95 @@
Combination of two patches that fix libopenshot tests when built with
system-provided ffmpeg and jsoncpp. See
https://github.com/OpenShot/libopenshot/pull/163
From 0d7691ab53433e1583f6a66ea96683b0f7af8a57 Mon Sep 17 00:00:00 2001
From: "FeRD (Frank Dana)" <ferdnyc@gmail.com>
Date: Mon, 17 Sep 2018 14:04:40 -0400
Subject: [PATCH] tests/CMakeFiles: Use FFMpeg like src/
---
tests/CMakeLists.txt | 32 +++++++++++++++++++++++++++++++-
1 file changed, 31 insertions(+), 1 deletion(-)
diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt
index 2c45550..4df8464 100644
--- a/tests/CMakeLists.txt
+++ b/tests/CMakeLists.txt
@@ -79,7 +79,37 @@ ENDIF (ImageMagick_FOUND)
FIND_PACKAGE(FFmpeg REQUIRED)
# Include FFmpeg headers (needed for compile)
-include_directories(${FFMPEG_INCLUDE_DIR})
+message('AVCODEC_FOUND: ${AVCODEC_FOUND}')
+message('AVCODEC_INCLUDE_DIRS: ${AVCODEC_INCLUDE_DIRS}')
+message('AVCODEC_LIBRARIES: ${AVCODEC_LIBRARIES}')
+
+IF (AVCODEC_FOUND)
+ include_directories(${AVCODEC_INCLUDE_DIRS})
+ENDIF (AVCODEC_FOUND)
+IF (AVDEVICE_FOUND)
+ include_directories(${AVDEVICE_INCLUDE_DIRS})
+ENDIF (AVDEVICE_FOUND)
+IF (AVFORMAT_FOUND)
+ include_directories(${AVFORMAT_INCLUDE_DIRS})
+ENDIF (AVFORMAT_FOUND)
+IF (AVFILTER_FOUND)
+ include_directories(${AVFILTER_INCLUDE_DIRS})
+ENDIF (AVFILTER_FOUND)
+IF (AVUTIL_FOUND)
+ include_directories(${AVUTIL_INCLUDE_DIRS})
+ENDIF (AVUTIL_FOUND)
+IF (POSTPROC_FOUND)
+ include_directories(${POSTPROC_INCLUDE_DIRS})
+ENDIF (POSTPROC_FOUND)
+IF (SWSCALE_FOUND)
+ include_directories(${SWSCALE_INCLUDE_DIRS})
+ENDIF (SWSCALE_FOUND)
+IF (SWRESAMPLE_FOUND)
+ include_directories(${SWRESAMPLE_INCLUDE_DIRS})
+ENDIF (SWRESAMPLE_FOUND)
+IF (AVRESAMPLE_FOUND)
+ include_directories(${AVRESAMPLE_INCLUDE_DIRS})
+ENDIF (AVRESAMPLE_FOUND)
################# LIBOPENSHOT-AUDIO ###################
# Find JUCE-based openshot Audio libraries
From e9e85cdfd036587adb86341f7f81619dc69f102c Mon Sep 17 00:00:00 2001
From: "FeRD (Frank Dana)" <ferdnyc@gmail.com>
Date: Mon, 17 Sep 2018 19:23:25 -0400
Subject: [PATCH] Use system jsoncpp in tests, too
The tests/ build needs to use the same jsoncpp as the src/ build,
or tests in Clip_Tests.cpp can fail.
---
tests/CMakeLists.txt | 10 ++++++++--
1 file changed, 8 insertions(+), 2 deletions(-)
diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt
index 4df8464..a1a0356 100644
--- a/tests/CMakeLists.txt
+++ b/tests/CMakeLists.txt
@@ -180,12 +180,18 @@ endif(OPENMP_FOUND)
# Find ZeroMQ library (used for socket communication & logging)
FIND_PACKAGE(ZMQ REQUIRED)
-# Include FFmpeg headers (needed for compile)
+# Include ZeroMQ headers (needed for compile)
include_directories(${ZMQ_INCLUDE_DIRS})
################### JSONCPP #####################
# Include jsoncpp headers (needed for JSON parsing)
-include_directories("../thirdparty/jsoncpp/include")
+if (USE_SYSTEM_JSONCPP)
+ find_package(JsonCpp REQUIRED)
+ include_directories(${JSONCPP_INCLUDE_DIRS})
+else()
+ message("Using embedded JsonCpp")
+ include_directories("../thirdparty/jsoncpp/include")
+endif(USE_SYSTEM_JSONCPP)
IF (NOT DISABLE_TESTS)
############### SET TEST SOURCE FILES #################

View File

@ -0,0 +1,72 @@
Fix build with recent Poppler.
From d867ec3c386baaed1b8e076dd70b278863411480 Mon Sep 17 00:00:00 2001
From: Jean Ghali <jghali@libertysurf.fr>
Date: Mon, 30 Apr 2018 09:19:33 +0000
Subject: [PATCH] =?UTF-8?q?#15289:=20FTBFS=201.5.4=20with=20error:=20inval?=
=?UTF-8?q?id=20conversion=20from=20=E2=80=98const=20GooString*=E2=80=99?=
=?UTF-8?q?=20to=20=E2=80=98GooString*=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
git-svn-id: svn://scribus.net/trunk/Scribus@22498 11d20701-8431-0410-a711-e3c959e3b870
---
scribus/plugins/import/pdf/importpdf.cpp | 2 +-
scribus/plugins/import/pdf/importpdf.h | 2 +-
scribus/plugins/import/pdf/slaoutput.cpp | 2 +-
scribus/plugins/import/pdf/slaoutput.h | 2 +-
4 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/scribus/plugins/import/pdf/importpdf.cpp b/scribus/plugins/import/pdf/importpdf.cpp
index c1802861aa..d4c5a9ba49 100644
--- a/scribus/plugins/import/pdf/importpdf.cpp
+++ b/scribus/plugins/import/pdf/importpdf.cpp
@@ -1081,7 +1081,7 @@ QRectF PdfPlug::getCBox(int box, int pgNum)
return cRect;
}
-QString PdfPlug::UnicodeParsedString(GooString *s1)
+QString PdfPlug::UnicodeParsedString(const GooString *s1)
{
if ( !s1 || s1->getLength() == 0 )
return QString();
diff --git a/scribus/plugins/import/pdf/importpdf.h b/scribus/plugins/import/pdf/importpdf.h
index c8c5efcd0d..5249562692 100644
--- a/scribus/plugins/import/pdf/importpdf.h
+++ b/scribus/plugins/import/pdf/importpdf.h
@@ -81,7 +81,7 @@ class PdfPlug : public QObject
private:
bool convert(const QString& fn);
QRectF getCBox(int box, int pgNum);
- QString UnicodeParsedString(GooString *s1);
+ QString UnicodeParsedString(const GooString *s1);
QList<PageItem*> Elements;
double baseX, baseY;
diff --git a/scribus/plugins/import/pdf/slaoutput.cpp b/scribus/plugins/import/pdf/slaoutput.cpp
index be1815dc29..17b6357246 100644
--- a/scribus/plugins/import/pdf/slaoutput.cpp
+++ b/scribus/plugins/import/pdf/slaoutput.cpp
@@ -4252,7 +4252,7 @@ void SlaOutputDev::pushGroup(QString maskName, GBool forSoftMask, GBool alpha, b
m_groupStack.push(gElements);
}
-QString SlaOutputDev::UnicodeParsedString(GooString *s1)
+QString SlaOutputDev::UnicodeParsedString(const GooString *s1)
{
if ( !s1 || s1->getLength() == 0 )
return QString();
diff --git a/scribus/plugins/import/pdf/slaoutput.h b/scribus/plugins/import/pdf/slaoutput.h
index 20e8b2d311..6698c030e0 100644
--- a/scribus/plugins/import/pdf/slaoutput.h
+++ b/scribus/plugins/import/pdf/slaoutput.h
@@ -266,7 +266,7 @@ class SlaOutputDev : public OutputDev
int getBlendMode(GfxState *state);
void applyMask(PageItem *ite);
void pushGroup(QString maskName = "", GBool forSoftMask = gFalse, GBool alpha = gFalse, bool inverted = false);
- QString UnicodeParsedString(GooString *s1);
+ QString UnicodeParsedString(const GooString *s1);
bool checkClip();
bool pathIsClosed;
QString CurrColorFill;

View File

@ -0,0 +1,36 @@
https://sources.debian.org/src/x265/2.9-3/debian/patches/0001-Fix-arm-flags.patch/
From: Sebastian Ramacher <sramacher@debian.org>
Date: Wed, 26 Apr 2017 22:05:06 +0200
Subject: Fix arm* flags
---
source/CMakeLists.txt | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/source/CMakeLists.txt b/source/CMakeLists.txt
index 33b6523..25aecbb 100644
--- a/source/CMakeLists.txt
+++ b/source/CMakeLists.txt
@@ -72,7 +72,7 @@ elseif(ARMMATCH GREATER "-1")
endif()
message(STATUS "Detected ARM target processor")
set(ARM 1)
- add_definitions(-DX265_ARCH_ARM=1 -DHAVE_ARMV6=1)
+ # add_definitions(-DX265_ARCH_ARM=1 -DHAVE_ARMV6=1)
else()
message(STATUS "CMAKE_SYSTEM_PROCESSOR value `${CMAKE_SYSTEM_PROCESSOR}` is unknown")
message(STATUS "Please add this value near ${CMAKE_CURRENT_LIST_FILE}:${CMAKE_CURRENT_LIST_LINE}")
@@ -230,12 +230,8 @@ if(GCC)
if(ARM AND CROSS_COMPILE_ARM)
set(ARM_ARGS -march=armv6 -mfloat-abi=soft -mfpu=vfp -marm -fPIC)
elseif(ARM)
- find_package(Neon)
if(CPU_HAS_NEON)
- set(ARM_ARGS -mcpu=native -mfloat-abi=hard -mfpu=neon -marm -fPIC)
add_definitions(-DHAVE_NEON)
- else()
- set(ARM_ARGS -mcpu=native -mfloat-abi=hard -mfpu=vfp -marm)
endif()
endif()
add_definitions(${ARM_ARGS})

View File

@ -0,0 +1,124 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Robin Templeton <robin@igalia.com>
;;;
;;; 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 packages phabricator)
#:use-module (gnu packages php)
#:use-module (gnu packages version-control)
#:use-module (guix build-system gnu)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages))
(define-public libphutil
(let ((commit "b29d76e1709ef018cc5edc7c03033fd9fdebc578")
(revision "1"))
(package
(name "libphutil")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/phacility/libphutil.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"06j84721r9r8624fmil62b5crs2qs0v6rr3cvv2zvkvwhxwrwv1l"))))
(build-system gnu-build-system)
;; TODO: Unbundle jsonlint and porter-stemmer.
(arguments
'(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(replace 'install
(lambda _
(let ((lib (string-append %output "/lib/libphutil")))
(mkdir-p lib)
(copy-recursively "." lib))
#t)))))
(inputs
`(("php" ,php)))
(home-page "https://github.com/phacility/libphutil")
(synopsis "PHP utility library")
(description
"@code{libphutil} is a collection of utility classes and functions for
PHP.")
;; Bundled libraries are expat-licensed.
(license (list license:asl2.0 license:expat)))))
(define-public arcanist
(let ((commit "45a8d22c74a62624e69f5cd6ce901c9ab2658904")
(revision "1"))
(package
(name "arcanist")
(version (git-version "0.0.0" revision commit))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/phacility/arcanist.git")
(commit commit)))
(file-name (git-file-name name version))
(sha256
(base32
"13vswhqy9sap6841y93j4mj71dl27vhcivcn3rzyi0cchkhg2ac9"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'configure)
(delete 'build)
(replace 'install
(lambda _
(let ((bin (string-append %output "/bin"))
(lib (string-append %output "/lib/arcanist")))
(mkdir-p lib)
(copy-recursively "." lib)
(mkdir-p bin)
(symlink (string-append lib "/bin/arc")
(string-append bin "/arc"))
(wrap-program (string-append bin "/arc")
`("ARC_PHUTIL_PATH" =
(,(string-append (assoc-ref %build-inputs "libphutil")
"/lib/libphutil")))
`("PATH" ":" prefix
(,@(map (lambda (i)
(string-append (assoc-ref %build-inputs i) "/bin"))
'("git" "mercurial" "subversion"))))))
#t))
(add-before 'reset-gzip-timestamps 'make-compressed-files-writable
(lambda _
(for-each make-file-writable
(find-files %output ".*\\.t?gz$"))
#t)))))
(inputs
`(("php" ,php)
("libphutil" ,libphutil)
("git" ,git)
("mercurial" ,mercurial)
("subversion" ,subversion)))
(home-page "https://github.com/phacility/arcanist")
(synopsis "Command-line interface for Phabricator")
(description
"Arcanist is the command-line tool for the Phabricator software
development service. It allows you to interact with Phabricator installs to
send code for review, download patches, transfer files, view status, make API
calls, and various other things.")
(license license:asl2.0))))

View File

@ -5308,20 +5308,34 @@ SVG, EPS, PNG and terminal output.")
(define-public python-seaborn
(package
(name "python-seaborn")
(version "0.7.1")
(version "0.9.0")
(source
(origin
(method url-fetch)
(uri (pypi-uri "seaborn" version))
(sha256
(base32 "0pawrqc3mxpwd5g9pvi9gba02637bh5c8ldpp8izfwpfn52469zs"))))
(base32 "0bqysi3fxfjl1866m5jq8z7mynhqbqnikim74dmzn8539iwkzj3n"))))
(build-system python-build-system)
(arguments
'(#:tests? #f)) ; Tests requires a running X11 server.
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'start-xserver
(lambda* (#:key inputs #:allow-other-keys)
(let ((xorg-server (assoc-ref inputs "xorg-server")))
;; There must be a running X server and make check doesn't
;; start one. Therefore we must do it.
(system (format #f "~a/bin/Xvfb :1 &" xorg-server))
(setenv "DISPLAY" ":1")
#t)))
(replace 'check (lambda _ (invoke "pytest" "seaborn") #t)))))
(propagated-inputs
`(("python-pandas" ,python-pandas)
("python-matplotlib" ,python-matplotlib)
("python-numpy" ,python-numpy)
("python-scipy" ,python-scipy)))
(native-inputs
`(("python-pytest" ,python-pytest)
("xorg-server" ,xorg-server)))
(home-page "http://stanford.edu/~mwaskom/software/seaborn/")
(synopsis "Statistical data visualization")
(description
@ -5329,15 +5343,10 @@ SVG, EPS, PNG and terminal output.")
graphics in Python. It is built on top of matplotlib and tightly integrated
with the PyData stack, including support for numpy and pandas data structures
and statistical routines from scipy and statsmodels.")
(license license:bsd-3)
(properties `((python2-variant . ,(delay python2-seaborn))))))
(license license:bsd-3)))
(define-public python2-seaborn
(let ((base (package-with-python2 (strip-python2-variant python-seaborn))))
(package
(inherit base)
(propagated-inputs `(("python2-pytz" ,python2-pytz)
,@(package-propagated-inputs base))))))
(package-with-python2 python-seaborn))
(define-public python-mpmath
(package
@ -9964,25 +9973,10 @@ hardware-accelerated multitouch applications.")
(package-with-python2 python-kivy))
(define-public python-kivy-next
(let ((commit "a988c5e7a47da56263ff39514264a3de516ef2fe")
(revision "1"))
(package (inherit python-kivy)
(name "python-kivy-next")
(version (string-append "1.9.1-" revision "."
(string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/kivy/kivy")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"0jk92b4a8l7blkvkgkjihk171s0dfnq582cckff5srwc8kal5m0p")))))))
(deprecated-package "python-kivy-next" python-kivy))
(define-public python2-kivy-next
(package-with-python2 python-kivy-next))
(deprecated-package "python2-kivy-next" python2-kivy))
(define-public python-binaryornot
(package

View File

@ -10,6 +10,7 @@
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2018 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2171,7 +2172,15 @@ different kinds of sliders, and much more.")
#:configure-flags (list ;"-DENABLE_API_TESTS=TRUE"
"-DPORT=Qt"
"-DUSE_LIBHYPHEN=OFF"
"-DUSE_SYSTEM_MALLOC=ON")))
"-DUSE_SYSTEM_MALLOC=ON"
;; XXX: relative dir installs to build dir?
(string-append "-DECM_MKSPECS_INSTALL_DIR="
%output "/lib/qt5/mkspecs/modules")
;; Sacrifice a little speed in order to link
;; libraries and test executables in a
;; reasonable amount of memory.
"-DCMAKE_SHARED_LINKER_FLAGS=-Wl,--no-keep-memory"
"-DCMAKE_EXE_LINKER_FLAGS=-Wl,--no-keep-memory")))
(home-page "https://www.webkit.org")
(synopsis "Web browser engine and classes to render and interact with web
content")

View File

@ -206,16 +206,21 @@ features an integrated Emacs-like editor and a large runtime library.")
(properties '((ftp-directory . "/gnu/mit-scheme/stable.pkg")))))
(define-public bigloo
;; Upstream modifies source tarballs in place, making significant changes
;; long after the initial publication: <https://bugs.gnu.org/33525>. For
;; transparency, we give this "second 4.3b" release a different version
;; number.
(let ((upstream-version "4.3b"))
(package
(name "bigloo")
(version "4.3b")
(version "4.3b2")
(source (origin
(method url-fetch)
(uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo"
version ".tar.gz"))
upstream-version ".tar.gz"))
(sha256
(base32
"1x7xdgsls277zlf6gcaxs2cj62xj6yvb0qxh0ddmxfamvxba0cf4"))
"02s0wrz5b1p0yqk9x6kax1vwzil7g9cyxfvl3vmy7fzznsza9gs4"))
;; Remove bundled libraries.
(modules '((guix build utils)))
(snippet
@ -257,7 +262,7 @@ features an integrated Emacs-like editor and a large runtime library.")
"--cflags=-fPIC"
(string-append "--ldflags=-Wl,-rpath="
(assoc-ref outputs "out")
"/lib/bigloo/" ,version)
"/lib/bigloo/" ,upstream-version)
(string-append "--lispdir=" out
"/share/emacs/site-lisp")
"--sharedbde=yes"
@ -289,15 +294,14 @@ features an integrated Emacs-like editor and a large runtime library.")
(home-page "http://www-sop.inria.fr/indes/fp/Bigloo/")
(synopsis "Efficient Scheme compiler")
(description
"Bigloo is a Scheme implementation devoted to one goal: enabling
Scheme based programming style where C(++) is usually
required. Bigloo attempts to make Scheme practical by offering
features usually presented by traditional programming languages
but not offered by Scheme and functional programming. Bigloo
compiles Scheme modules. It delivers small and fast stand alone
binary executables. Bigloo enables full connections between
Scheme and C programs and between Scheme and Java programs.")
(license gpl2+)))
"Bigloo is a Scheme implementation devoted to one goal: enabling Scheme
based programming style where C(++) is usually required. Bigloo attempts to
make Scheme practical by offering features usually presented by traditional
programming languages but not offered by Scheme and functional programming.
Bigloo compiles Scheme modules. It delivers small and fast stand alone binary
executables. Bigloo enables full connections between Scheme and C programs
and between Scheme and Java programs.")
(license gpl2+))))
(define-public hop
(package

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017, 2018 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
@ -56,7 +56,7 @@
(sha256
(base32
"00ys0p6h3iq77kh72dkl0qrf7qvznq18qdrgiq10gfxja1995034"))
(modules '((guix build utils)))))
(patches (search-patches "scribus-poppler.patch"))))
(build-system cmake-build-system)
(arguments
`(#:tests? #f ;no test target

View File

@ -457,6 +457,70 @@ everything from small to very large projects with speed and efficiency.")
(license license:gpl2)
(home-page "https://git-scm.com/")))
(define-public git-minimal
;; The size of the closure of 'git-minimal' is two thirds that of 'git'.
;; Its test suite runs slightly faster and most importantly it doesn't
;; depend on packages that are expensive to build such as Subversion.
(package
(inherit git)
(name "git-minimal")
(arguments
(substitute-keyword-arguments (package-arguments git)
((#:phases phases)
`(modify-phases ,phases
(replace 'patch-makefiles
(lambda _
(substitute* "Makefile"
(("/usr/bin/perl") (which "perl")))
#t))
(delete 'build-subtree)
(delete 'split)
(delete 'install-man-pages)
(delete 'install-subtree)
(delete 'install-credential-netrc)
(add-before 'check 'delete-svn-test
(lambda _
;; This test cannot run since we are not building 'git-svn'.
(delete-file "t/t9020-remote-svn.sh")
#t))
(add-after 'install 'remove-unusable-perl-commands
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(libexec (string-append out "/libexec")))
(for-each (lambda (file)
(delete-file (string-append libexec
"/git-core/" file)))
'("git-svn" "git-cvsimport" "git-archimport"
"git-cvsserver" "git-request-pull"
"git-add--interactive" "git-cvsexportcommit"
"git-instaweb" "git-send-email"))
(delete-file (string-append bin "/git-cvsserver"))
;; These templates typically depend on Perl. Remove them.
(delete-file-recursively
(string-append out "/share/git-core/templates/hooks"))
;; Gitweb depends on Perl as well.
(delete-file-recursively
(string-append out "/share/gitweb"))
#t)))))
((#:configure-flags flags)
''())
((#:disallowed-references lst '())
`(,perl ,@lst))))
(outputs '("out"))
(native-inputs
`(("native-perl" ,perl)
("gettext" ,gettext-minimal)))
(inputs
`(("curl" ,curl) ;for HTTP(S) access
("expat" ,expat) ;for 'git push' over HTTP(S)
("openssl" ,openssl)
("perl" ,perl)
("zlib" ,zlib)
("bash-for-tests" ,bash)))))
(define-public libgit2
(package
(name "libgit2")

View File

@ -12,7 +12,7 @@
;;; Copyright © 2016 Dmitry Nikolaev <cameltheman@gmail.com>
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2016, 2017 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017 Feng Shu <tumashu@163.com>
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
@ -112,6 +112,7 @@
#:use-module (gnu packages man)
#:use-module (gnu packages mp3)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages networking)
#:use-module (gnu packages ocr)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
@ -128,6 +129,7 @@
#:use-module (gnu packages serialization)
#:use-module (gnu packages shells)
#:use-module (gnu packages ssh)
#:use-module (gnu packages swig)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages textutils)
#:use-module (gnu packages tls)
@ -394,6 +396,7 @@ and creating Matroska files from other media files (@code{mkvmerge}).")
(package
(name "x265")
(version "2.9")
(outputs '("out" "static"))
(source
(origin
(method url-fetch)
@ -402,7 +405,8 @@ and creating Matroska files from other media files (@code{mkvmerge}).")
(sha256
(base32
"090hp4216isis8q5gb7bwzia8rfyzni54z21jnwm97x3hiy6ibpb"))
(patches (search-patches "x265-detect512-all-arches.patch"))
(patches (search-patches "x265-arm-flags.patch"
"x265-detect512-all-arches.patch"))
(modules '((guix build utils)))
(snippet '(begin
(delete-file-recursively "source/compat/getopt")
@ -410,14 +414,76 @@ and creating Matroska files from other media files (@code{mkvmerge}).")
(build-system cmake-build-system)
(arguments
`(#:tests? #f ; tests are skipped if cpu-optimized code isn't built
#:configure-flags
;; Ensure position independent code for everyone.
#:configure-flags '("-DENABLE_PIC=TRUE")
(list "-DENABLE_PIC=TRUE"
,@(if (string-prefix? "armhf" (or (%current-system)
(%current-target-system)))
'("-DENABLE_ASSEMBLY=OFF")
'())
(string-append "-DCMAKE_INSTALL_PREFIX="
(assoc-ref %outputs "out")))
#:phases
(modify-phases %standard-phases
(add-before 'configure 'prepare-build
(add-after 'unpack 'prepare-build
(lambda _
(delete-file-recursively "build")
(chdir "source")
;; recognize armv8 in 32-bit mode as ARM
(substitute* "CMakeLists.txt"
(("armv6l") "armv8l"))
#t))
(add-before 'configure 'build-12-bit
(lambda* (#:key (configure-flags '()) #:allow-other-keys)
(mkdir "../build-12bit")
(with-directory-excursion "../build-12bit"
(apply invoke
"cmake" "../source"
"-DHIGH_BIT_DEPTH=ON"
"-DEXPORT_C_API=OFF"
"-DENABLE_CLI=OFF"
"-DMAIN12=ON"
configure-flags)
(substitute* (cons "cmake_install.cmake"
(append
(find-files "CMakeFiles/x265-shared.dir" ".")
(find-files "CMakeFiles/x265-static.dir" ".")))
(("libx265") "libx265_main12"))
(invoke "make"))))
(add-before 'configure 'build-10-bit
(lambda* (#:key (configure-flags '()) #:allow-other-keys)
(mkdir "../build-10bit")
(with-directory-excursion "../build-10bit"
(apply invoke
"cmake" "../source"
"-DHIGH_BIT_DEPTH=ON"
"-DEXPORT_C_API=OFF"
"-DENABLE_CLI=OFF"
configure-flags)
(substitute* (cons "cmake_install.cmake"
(append
(find-files "CMakeFiles/x265-shared.dir" ".")
(find-files "CMakeFiles/x265-static.dir" ".")))
(("libx265") "libx265_main10"))
(invoke "make"))))
(add-after 'install 'install-more-libs
(lambda _
(with-directory-excursion "../build-12bit"
(invoke "make" "install"))
(with-directory-excursion "../build-10bit"
(invoke "make" "install"))))
(add-before 'strip 'move-static-libs
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(static (assoc-ref outputs "static")))
(mkdir-p (string-append static "/lib"))
(with-directory-excursion
(string-append out "/lib")
(for-each
(lambda (file)
(rename-file file
(string-append static "/lib/" file)))
(find-files "." "\\.a$"))))
#t)))))
(home-page "http://x265.org/")
(synopsis "Library for encoding h.265/HEVC video streams")
@ -3082,3 +3148,110 @@ as surfing, skiing, riding and walking while shooting videos are especially
prone to erratic camera shakes. Vidstab targets these video contents to help
create smoother and stable videos.")
(license license:gpl2+)))
(define-public libopenshot
(package
(name "libopenshot")
(version "0.2.2")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/OpenShot/libopenshot")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1x4kv05pdq1pglb6y056aa7llc6iyibyhzg93k7zwj0q08cp5ixd"))
(modules '((guix build utils)))
(snippet '(begin
;; Allow overriding of the python installation dir
(substitute* "src/bindings/python/CMakeLists.txt"
(("(SET\\(PYTHON_MODULE_PATH.*)\\)" _ set)
(string-append set " CACHE PATH "
"\"Python bindings directory\")")))
#t))
(patches (search-patches "libopenshot-tests-with-system-libs.patch"))))
(build-system cmake-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)
("python" ,python)
("swig" ,swig)
("unittest++" ,unittest-cpp)))
(propagated-inputs ;all referenced in installed headers
`(("cppzmq" ,cppzmq)
("ffmpeg" ,ffmpeg)
("imagemagick" ,imagemagick)
("jsoncpp" ,jsoncpp)
("libopenshot-audio" ,libopenshot-audio)
("qt" ,qt) ;widgets, core, gui, multimedia, and multimediawidgets
("zeromq" ,zeromq)))
(arguments
`(#:configure-flags
(list (string-append "-DPYTHON_MODULE_PATH:PATH=" %output "/lib/python"
,(version-major+minor (package-version python))
"/site-packages")
"-DUSE_SYSTEM_JSONCPP:BOOL=ON")
#:phases
(modify-phases %standard-phases
(add-before 'configure 'set-vars
(lambda* (#:key inputs #:allow-other-keys)
(setenv "LIBOPENSHOT_AUDIO_DIR"
(assoc-ref inputs "libopenshot-audio"))
(setenv "ZMQDIR"
(assoc-ref inputs "zeromq"))
(setenv "UNITTEST_DIR"
(string-append (assoc-ref inputs "unittest++")
"/include/UnitTest++"))
#t)))))
(home-page "https://openshot.org")
(synopsis "Video-editing, animation, and playback library")
(description "OpenShot Library (libopenshot) is a powerful C++ video
editing library with a multi-threaded and feature rich video editing
API. It includes bindings for Python, Ruby, and other languages.")
(license license:lgpl3+)))
(define-public openshot
(package
(name "openshot")
(version "2.4.3")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/OpenShot/openshot-qt")
(commit (string-append "v" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1qdw1mli4y9qhrnllnkaf6ydgw5vfvdb90chs4i679k0x0jyb9a2"))))
(build-system python-build-system)
(inputs
`(("ffmpeg" ,ffmpeg)
("libopenshot" ,libopenshot)
("python" ,python)
("python-pyqt" ,python-pyqt)
("python-pyzmq" ,python-pyzmq)
("python-requests" ,python-requests)
("qtsvg" ,qtsvg)))
(arguments
`(#:tests? #f ;no tests
#:phases (modify-phases %standard-phases
(delete 'build) ;install phase does all the work
(add-before 'install 'set-tmp-home
(lambda _
;; src/classes/info.py "needs" to create several
;; directories in $HOME when loaded during build
(setenv "HOME" "/tmp")
#t))
(add-after 'install 'wrap-program
(lambda* (#:key inputs outputs #:allow-other-keys)
(wrap-program (string-append (assoc-ref outputs "out")
"/bin/openshot-qt")
`("QT_PLUGIN_PATH" prefix
,(list (string-append (assoc-ref inputs "qtsvg")
"/lib/qt5/plugins/")))))))))
(home-page "https://openshot.org")
(synopsis "Video editor")
(description "OpenShot takes your videos, photos, and music files and
helps you create the film you have always dreamed of. Easily add sub-titles,
transitions, and effects and then export your film to many common formats.")
(license license:gpl3+)))

View File

@ -61,7 +61,7 @@
(define-public vim
(package
(name "vim")
(version "8.1.0026")
(version "8.1.0551")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/vim/vim/archive/v"
@ -69,7 +69,7 @@
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"14q99dn113czp522j34p71za6g1mkriy04xxwcbm3axnrrpv1y52"))))
"1wi6j9w04wg3hxsch3izl2mxb0065vpvxscz19zjn5ypkfypnm8n"))))
(build-system gnu-build-system)
(arguments
`(#:test-target "test"
@ -85,12 +85,18 @@
"src/testdir/test_terminal.vim")
(("/bin/sh") (which "sh")))
#t))
(add-before 'check 'patch-failing-test
(add-before 'check 'patch-failing-tests
(lambda _
;; XXX A single test fails with “Can't create file /dev/stdout” (at
;; Test_writefile_sync_dev_stdout line 5) while /dev/stdout exists.
(substitute* "src/testdir/test_writefile.vim"
(("/dev/stdout") "a-regular-file"))
;; XXX: This test fails when run in the build container:
;; <https://github.com/vim/vim/issues/3348>.
(substitute* "src/testdir/test_search.vim"
((".*'Test_incsearch_substitute_03'.*" all)
(string-append "\"" all "\n")))
#t)))))
(inputs
`(("gawk" ,gawk)

View File

@ -9,6 +9,7 @@
;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2018 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@ -998,3 +999,58 @@ the image.
@code{vagrant} command line executable, allowing programmatic control of Vagrant
virtual machines.")
(license license:expat)))
(define-public bubblewrap
(package
(name "bubblewrap")
(version "0.3.1")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/projectatomic/bubblewrap/"
"releases/download/v" version "/bubblewrap-"
version ".tar.xz"))
(sha256
(base32
"1y2bdlxnlr84xcbf31lzirc292c5ak9bd2wvcvh4ppsliih6pjny"))))
(build-system gnu-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-test
(lambda* (#:key outputs #:allow-other-keys)
;; Tests try to access /var/tmp, which is not possible in our build
;; environment. Let's give them another directory.
;; /tmp gets overriden in some tests, so we need another directory.
;; the only possibility is the output directory.
(let ((tmp-dir (string-append (assoc-ref outputs "out") "/tmp")))
(mkdir-p tmp-dir)
(substitute* "tests/test-run.sh"
(("/var/tmp") tmp-dir)
;; Tests create a temporary python script, so fix its shebang.
(("/usr/bin/env python") (which "python"))
;; Some tests try to access /usr, but that doesn't exist.
;; Give them /gnu instead.
(("/usr") "/gnu")
((" */bin/bash") (which "bash"))
(("/bin/sh") (which "sh"))
(("findmnt") (which "findmnt"))))
#t))
;; Remove the directory we gave to tests to have a clean package.
(add-after 'check 'remove-tmp-dir
(lambda* (#:key outputs #:allow-other-keys)
(delete-file-recursively (string-append (assoc-ref outputs "out") "/tmp"))
#t)))))
(inputs
`(("libcap" ,libcap)))
(native-inputs
`(("python-2" ,python-2)
("util-linux" ,util-linux)))
(home-page "https://github.com/projectatomic/bubblewrap")
(synopsis "Unprivileged sandboxing tool")
(description "Bubblewrap is aimed at running applications in a sandbox,
where it has restricted access to parts of the operating system or user data
such as the home directory. Bubblewrap always creates a new mount namespace,
and the user can specify exactly what parts of the filesystem should be visible
in the sandbox. Any such directories specified is mounted nodev by default,
and can be made readonly.")
(license license:lgpl2.0+)))

View File

@ -6,6 +6,7 @@
;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018 Timo Eisenmann <eisenmann@fn.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -48,6 +49,7 @@
#:use-module (gnu packages webkit)
#:use-module (gnu packages xorg)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix build-system glib-or-gtk)
#:use-module (guix build-system python))
@ -320,3 +322,40 @@ access.")
(description "qutebrowser is a keyboard-focused browser with a minimal
GUI. It is based on PyQt5 and QtWebKit.")
(license license:gpl3+)))
(define-public vimb
(package
(name "vimb")
(version "3.3.0")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/fanglingsu/vimb/")
(commit version)))
(sha256
(base32
"1qg18z2gnsli9qgrqfhqfrsi6g9mcgr90w8yab28nxrq4aha6brf"))
(file-name (git-file-name name version))))
(build-system glib-or-gtk-build-system)
(arguments
'(#:tests? #f ; no tests
#:make-flags (list "CC=gcc"
"DESTDIR="
(string-append "PREFIX=" %output))
#:phases
(modify-phases %standard-phases
(delete 'configure))))
(inputs
`(("glib-networking" ,glib-networking)
("gsettings-desktop-schemas" ,gsettings-desktop-schemas)
("webkitgtk" ,webkitgtk)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "https://fanglingsu.github.io/vimb/")
(synopsis "Fast and lightweight Vim-like web browser")
(description "Vimb is a fast and lightweight vim like web browser based on
the webkit web browser engine and the GTK toolkit. Vimb is modal like the great
vim editor and also easily configurable during runtime. Vimb is mostly keyboard
driven and does not detract you from your daily work.")
(license license:gpl3+)))

View File

@ -15,7 +15,7 @@
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2016 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2016, 2017 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016, 2017 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016, 2017, 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2016 Bake Timmons <b3timmons@speedymail.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
@ -5757,7 +5757,7 @@ named elements: the @code{status}, the @code{headers}, and the @code{body}.")
(define-public rss-bridge
(package
(name "rss-bridge")
(version "2018-03-11")
(version "2018-11-10")
(source
(origin
(method url-fetch)
@ -5766,7 +5766,7 @@ named elements: the @code{status}, the @code{headers}, and the @code{body}.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1ix15ck45yb659k63mhwxwia6qnm9nn8jw0bga85abrvk1rchjdn"))))
"1l9a82smh6k37bjvzbmkdlssxywlmr40ig4cykgsns1iiszwv4ia"))))
(build-system trivial-build-system)
(native-inputs
`(("gzip" ,gzip)

View File

@ -225,7 +225,7 @@ integrate Windows applications into your desktop.")
(define-public wine-staging-patchset-data
(package
(name "wine-staging-patchset-data")
(version "3.20")
(version "3.21")
(source
(origin
(method git-fetch)
@ -235,7 +235,7 @@ integrate Windows applications into your desktop.")
(file-name (git-file-name name version))
(sha256
(base32
"049cwllf4aybrhj4l2i3vd5jvagjz4d448404zkyy0lfxr08id3p"))))
"1bxryvqw5rvhcx8vjl714jaj0rjsrh95kh3sn499rrljc3c8qsbl"))))
(build-system trivial-build-system)
(native-inputs
`(("bash" ,bash)
@ -281,7 +281,7 @@ integrate Windows applications into your desktop.")
(file-name (string-append name "-" version ".tar.xz"))
(sha256
(base32
"063garmflbna3mhph8k0dv0bkzq8x75x5xrd0j8y0mjh10i13mik"))))
"1h70wb7kysbzv36i3fblyiihvalwhy6sj4s2a8nf21nz2mhc0k58"))))
(inputs `(("autoconf" ,autoconf) ; for autoreconf
("gtk+" ,gtk+)
("libva" ,libva)

View File

@ -518,7 +518,15 @@ of user-name/file-like tuples."
(service-extension activation-service-type
openssh-activation)
(service-extension account-service-type
(const %openssh-accounts))))
(const %openssh-accounts))
;; Install OpenSSH in the system profile. That way,
;; 'scp' is found when someone tries to copy to or from
;; this machine.
(service-extension profile-service-type
(lambda (config)
(list (openssh-configuration-openssh
config))))))
(compose concatenate)
(extend extend-openssh-authorized-keys)
(default-value (openssh-configuration))))

View File

@ -3,7 +3,7 @@
(use-modules (gnu))
(use-service-modules networking ssh)
(use-package-modules screen ssh)
(use-package-modules screen)
(operating-system
(host-name "komputilo")
@ -40,7 +40,7 @@
%base-user-accounts))
;; Globally-installed packages.
(packages (cons* screen openssh %base-packages))
(packages (cons screen %base-packages))
;; Add services to the baseline: a DHCP client and
;; an SSH server.

View File

@ -47,6 +47,7 @@
channel-instance-checkout
latest-channel-instances
checkout->channel-instance
latest-channel-derivation
channel-instances->manifest
channel-instances->derivation))
@ -114,6 +115,17 @@ CHANNELS."
(channel-instance channel commit checkout)))
channels))
(define* (checkout->channel-instance checkout
#:key commit
(url checkout) (name 'guix))
"Return a channel instance for CHECKOUT, which is assumed to be a checkout
of COMMIT at URL. Use NAME as the channel name."
(let* ((commit (or commit (make-string 40 #\0)))
(channel (channel (name name)
(commit commit)
(url url))))
(channel-instance channel commit checkout)))
(define %self-build-file
;; The file containing code to build Guix. This serves the same purpose as
;; a makefile, and, similarly, is intended to always keep this name.

View File

@ -80,6 +80,7 @@
substitutable-derivation?
substitution-oracle
derivation-hash
derivation-properties
read-derivation
read-derivation-from-file
@ -681,7 +682,8 @@ name of each input with that input's hash."
references-graphs
allowed-references disallowed-references
leaked-env-vars local-build?
(substitutable? #t))
(substitutable? #t)
(properties '()))
"Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in
@ -708,7 +710,10 @@ for offloading and should rather be built locally. This is the case for small
derivations where the costs of data transfers would outweigh the benefits.
When SUBSTITUTABLE? is false, declare that substitutes of the derivation's
output should not be used."
output should not be used.
PROPERTIES must be an association list describing \"properties\" of the
derivation. It is kept as-is, uninterpreted, in the derivation."
(define (add-output-paths drv)
;; Return DRV with an actual store path for each of its output and the
;; corresponding environment variable.
@ -763,6 +768,10 @@ output should not be used."
`(("impureEnvVars"
. ,(string-join leaked-env-vars)))
'())
,@(match properties
(() '())
(lst `(("guix properties"
. ,(object->string properties)))))
,@env-vars)))
(match references-graphs
(((file . path) ...)
@ -851,6 +860,14 @@ long-running processes that know what they're doing. Use with care!"
(invalidate-memoization! derivation-path->base16-hash)
(hash-clear! %derivation-cache))
(define derivation-properties
(mlambdaq (drv)
"Return the property alist associated with DRV."
(match (assoc "guix properties"
(derivation-builder-environment-vars drv))
((_ . str) (call-with-input-string str read))
(#f '()))))
(define* (map-derivation store drv mapping
#:key (system (%current-system)))
"Given MAPPING, a list of pairs of derivations, return a derivation based on
@ -1129,7 +1146,8 @@ they can refer to each other."
references-graphs
allowed-references
disallowed-references
local-build? (substitutable? #t))
local-build? (substitutable? #t)
(properties '()))
"Return a derivation that executes Scheme expression EXP as a builder
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list
@ -1149,7 +1167,8 @@ EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, SUBSTITUTABLE?,
and PROPERTIES."
(define guile-drv
(or guile-for-build (%guile-for-build)))
@ -1277,7 +1296,8 @@ ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:local-build? local-build?
#:substitutable? substitutable?)))
#:substitutable? substitutable?
#:properties properties)))
;;;

View File

@ -209,8 +209,13 @@ SRFI-19 time-utc object, as the creation time in metadata."
;; the path "/a" into "/". The presence of "/" in the archive is
;; probably benign, but it is definitely safe to remove it, so let's
;; do that. This fails when "/" is not in the archive, so use system*
;; instead of invoke to avoid an exception in that case.
(system* "tar" "--delete" "/" "-f" "layer.tar")
;; instead of invoke to avoid an exception in that case, and redirect
;; stderr to the bit bucket to avoid "Exiting with failure status"
;; error messages.
(with-error-to-port (%make-void-port "w")
(lambda ()
(system* "tar" "--delete" "/" "-f" "layer.tar")))
(for-each delete-file-recursively
(map (compose topmost-component symlink-source)
symlinks))

View File

@ -373,14 +373,24 @@
;; procedure that takes a file name, an algorithm (symbol) and a hash
;; (bytevector), and returns a URL or #f.
'(begin
(use-modules (guix base32) (guix base16))
(use-modules (guix base32))
(list (lambda (file algo hash)
(define (guix-publish host)
(lambda (file algo hash)
;; Files served by 'guix publish' are accessible under a single
;; hash algorithm.
(string-append "https://mirror.hydra.gnu.org/file/"
(string-append "https://" host "/file/"
file "/" (symbol->string algo) "/"
(bytevector->nix-base32-string hash)))
(bytevector->nix-base32-string hash))))
;; XXX: (guix base16) appeared in March 2017 (and thus 0.13.0) so old
;; installations of the daemon might lack it. Thus, load it lazily to
;; avoid gratuitous errors. See <https://bugs.gnu.org/33542>.
(module-autoload! (current-module)
'(guix base16) '(bytevector->base16-string))
(list (guix-publish "mirror.hydra.gnu.org")
(guix-publish "berlin.guixsd.org")
(lambda (file algo hash)
;; 'tarballs.nixos.org' supports several algorithms.
(string-append "https://tarballs.nixos.org/"

View File

@ -631,6 +631,8 @@ names and file names suitable for the #:allowed-references argument to
allowed-references disallowed-references
leaked-env-vars
local-build? (substitutable? #t)
(properties '())
deprecation-warnings
(script-name (string-append name "-builder")))
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
@ -788,7 +790,8 @@ The other arguments are as for 'derivation'."
#:disallowed-references disallowed
#:leaked-env-vars leaked-env-vars
#:local-build? local-build?
#:substitutable? substitutable?))))
#:substitutable? substitutable?
#:properties properties))))
(define* (gexp-inputs exp #:key native?)
"Return the input list for EXP. When NATIVE? is true, return only native

View File

@ -60,7 +60,7 @@
(define (git-package)
"Return the default Git package."
(let ((distro (resolve-interface '(gnu packages version-control))))
(module-ref distro 'git)))
(module-ref distro 'git-minimal)))
(define* (git-fetch ref hash-algo hash
#:optional name
@ -74,11 +74,22 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
;; available so that 'git submodule' works.
(if (git-reference-recursive? ref)
(standard-packages)
'()))
;; The 'swh-download' procedure requires tar and gzip.
`(("gzip" ,(module-ref (resolve-interface '(gnu packages compression))
'gzip))
("tar" ,(module-ref (resolve-interface '(gnu packages base))
'tar)))))
(define zlib
(module-ref (resolve-interface '(gnu packages compression)) 'zlib))
(define guile-json
(module-ref (resolve-interface '(gnu packages guile)) 'guile-json))
(define gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'gnutls))
(define config.scm
(scheme-file "config.scm"
#~(begin
@ -93,16 +104,22 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(delete '(guix config)
(source-module-closure '((guix build git)
(guix build utils)
(guix build download-nar))))))
(guix build download-nar)
(guix swh))))))
(define build
(with-imported-modules modules
(with-extensions (list guile-json gnutls) ;for (guix swh)
#~(begin
(use-modules (guix build git)
(guix build utils)
(guix build download-nar)
(guix swh)
(ice-9 match))
(define recursive?
(call-with-input-string (getenv "git recursive?") read))
;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin")
@ -110,13 +127,20 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(((names dirs outputs ...) ...)
dirs)))
(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)
(or (git-fetch (getenv "git url") (getenv "git commit")
#$output
#:recursive? (call-with-input-string
(getenv "git recursive?")
read)
#:recursive? recursive?
#:git-command (string-append #+git "/bin/git"))
(download-nar #$output)))))
(download-nar #$output)
;; As a last resort, attempt to download from Software Heritage.
;; XXX: Currently recursive checkouts are not supported.
(and (not recursive?)
(swh-download (getenv "git url") (getenv "git commit")
#$output)))))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build

View File

@ -123,6 +123,10 @@ are not recursively applied to dependencies of DRV."
(define add-label
(cut cons "x" <>))
(define properties
`((type . graft)
(graft (count . ,(length grafts)))))
(match grafts
((($ <graft> sources source-outputs targets target-outputs) ...)
(let ((sources (zip sources source-outputs))
@ -140,7 +144,8 @@ are not recursively applied to dependencies of DRV."
,@(append (map add-label sources)
(map add-label targets)))
#:outputs outputs
#:local-build? #t)))))
#:local-build? #t
#:properties properties)))))
(define (item->deriver store item)
"Return two values: the derivation that led to ITEM (a store item), and the
name of the output of that derivation ITEM corresponds to (for example

View File

@ -56,6 +56,7 @@
open-inferior
close-inferior
inferior-eval
inferior-eval-with-store
inferior-object?
inferior-packages
@ -402,6 +403,48 @@ input/output ports.)"
(unless (port-closed? client)
(loop))))))
(define (inferior-eval-with-store inferior store code)
"Evaluate CODE in INFERIOR, passing it STORE as its argument. CODE must
thus be the code of a one-argument procedure that accepts a store."
;; Create a named socket in /tmp and let INFERIOR connect to it and use it
;; as its store. This ensures the inferior uses the same store, with the
;; same options, the same per-session GC roots, etc.
(call-with-temporary-directory
(lambda (directory)
(chmod directory #o700)
(let* ((name (string-append directory "/inferior"))
(socket (socket AF_UNIX SOCK_STREAM 0))
(major (nix-server-major-version store))
(minor (nix-server-minor-version store))
(proto (logior major minor)))
(bind socket AF_UNIX name)
(listen socket 1024)
(send-inferior-request
`(let ((proc ,code)
(socket (socket AF_UNIX SOCK_STREAM 0)))
(connect socket AF_UNIX ,name)
;; 'port->connection' appeared in June 2018 and we can hardly
;; emulate it on older versions. Thus fall back to
;; 'open-connection', at the risk of talking to the wrong daemon or
;; having our build result reclaimed (XXX).
(let ((store (if (defined? 'port->connection)
(port->connection socket #:version ,proto)
(open-connection))))
(dynamic-wind
(const #t)
(lambda ()
(proc store))
(lambda ()
(close-connection store)
(close-port socket)))))
inferior)
(match (accept socket)
((client . address)
(proxy client (nix-server-socket store))))
(close-port socket)
(read-inferior-response inferior)))))
(define* (inferior-package-derivation store package
#:optional
(system (%current-system))
@ -409,32 +452,9 @@ input/output ports.)"
"Return the derivation for PACKAGE, an inferior package, built for SYSTEM
and cross-built for TARGET if TARGET is true. The inferior corresponding to
PACKAGE must be live."
;; Create a named socket in /tmp and let the inferior of PACKAGE connect to
;; it and use it as its store. This ensures the inferior uses the same
;; store, with the same options, the same per-session GC roots, etc.
(call-with-temporary-directory
(lambda (directory)
(chmod directory #o700)
(let* ((name (string-append directory "/inferior"))
(socket (socket AF_UNIX SOCK_STREAM 0))
(inferior (inferior-package-inferior package))
(major (nix-server-major-version store))
(minor (nix-server-minor-version store))
(proto (logior major minor)))
(bind socket AF_UNIX name)
(listen socket 1024)
(send-inferior-request
`(let ((socket (socket AF_UNIX SOCK_STREAM 0)))
(connect socket AF_UNIX ,name)
;; 'port->connection' appeared in June 2018 and we can hardly
;; emulate it on older versions. Thus fall back to
;; 'open-connection', at the risk of talking to the wrong daemon or
;; having our build result reclaimed (XXX).
(let* ((store (if (defined? 'port->connection)
(port->connection socket #:version ,proto)
(open-connection)))
(package (hashv-ref %package-table
(define proc
`(lambda (store)
(let* ((package (hashv-ref %package-table
,(inferior-package-id package)))
(drv ,(if target
`(package-cross-derivation store package
@ -442,15 +462,11 @@ PACKAGE must be live."
,system)
`(package-derivation store package
,system))))
(close-connection store)
(close-port socket)
(derivation-file-name drv)))
inferior)
(match (accept socket)
((client . address)
(proxy client (nix-server-socket store))))
(close-port socket)
(read-derivation-from-file (read-inferior-response inferior))))))
(derivation-file-name drv))))
(and=> (inferior-eval-with-store (inferior-package-inferior package) store
proc)
read-derivation-from-file))
(define inferior-package->derivation
(store-lift inferior-package-derivation))

View File

@ -103,11 +103,11 @@ Display information about the channels currently in use.\n"))
(format port "url: ~a~%" (channel-url channel))
(format port "commit: ~a~%" (channel-commit channel)))
(define* (display-checkout-info fmt #:optional directory)
(define (display-checkout-info fmt)
"Display information about the current checkout according to FMT, a symbol
denoting the requested format. Exit if the current directory does not lie
within a Git checkout."
(let* ((program (or directory (car (command-line))))
(let* ((program (car (command-line)))
(directory (catch 'git-error
(lambda ()
(repository-discover (dirname program)))

View File

@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;;
;;; This file is part of GNU Guix.
;;;
@ -44,7 +45,7 @@
`((format . ,bytevector->nix-base32-string)))
(define (show-help)
(display (G_ "Usage: gcrypt hash [OPTION] FILE
(display (G_ "Usage: guix hash [OPTION] FILE
Return the cryptographic hash of FILE.
Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex'
@ -93,7 +94,7 @@ and 'hexadecimal' can be used as well).\n"))
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "gcrypt hash")))))
(show-version-and-exit "guix hash")))))

View File

@ -3,6 +3,7 @@
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -609,6 +610,18 @@ please email '~a'~%")
(squashfs . ,squashfs-image)
(docker . ,docker-image)))
(define (show-formats)
;; Print the supported pack formats.
(display (G_ "The supported formats for 'guix pack' are:"))
(newline)
(display (G_ "
tarball Self-contained tarball, ready to run on another machine"))
(display (G_ "
squashfs Squashfs image suitable for Singularity"))
(display (G_ "
docker Tarball ready for 'docker load'"))
(newline))
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@ -625,6 +638,10 @@ please email '~a'~%")
(option '(#\f "format") #t #f
(lambda (opt name arg result)
(alist-cons 'format (string->symbol arg) result)))
(option '("list-formats") #f #f
(lambda args
(show-formats)
(exit 0)))
(option '(#\R "relocatable") #f #f
(lambda (opt name arg result)
(alist-cons 'relocatable? #t result)))
@ -686,6 +703,8 @@ Create a bundle of PACKAGE.\n"))
(newline)
(display (G_ "
-f, --format=FORMAT build a pack in the given FORMAT"))
(display (G_ "
--list-formats list the formats available"))
(display (G_ "
-R, --relocatable produce relocatable executables"))
(display (G_ "

View File

@ -188,7 +188,10 @@ call THUNK."
(save-module-excursion
(lambda ()
(set-current-module user-module)
(start-repl))))
;; Do not exit repl on SIGINT.
((@@ (ice-9 top-repl) call-with-sigint)
(lambda ()
(start-repl))))))
((machine)
(machine-repl))
(else

View File

@ -297,9 +297,11 @@ Return the list of store items actually sent."
(channel-send-eof port)
;; Wait for completion of the remote process and read the status sexp from
;; PORT.
;; PORT. Wait for the exit status only when 'read' completed; otherwise,
;; we might wait forever if the other end is stuck.
(let* ((result (false-if-exception (read port)))
(status (zero? (channel-get-exit-status port))))
(status (and result
(zero? (channel-get-exit-status port)))))
(close-port port)
(match result
(('success . _)

View File

@ -325,7 +325,19 @@ addition to build events."
(display "\r" port)) ;erase the spinner
(match event
(('build-started drv . _)
(format port (info (G_ "building ~a...")) drv)
(let ((properties (derivation-properties
(read-derivation-from-file drv))))
(match (assq-ref properties 'type)
('graft
(let ((count (match (assq-ref properties 'graft)
(#f 0)
(lst (or (assq-ref lst 'count) 0)))))
(format port (info (N_ "applying ~a graft for ~a..."
"applying ~a grafts for ~a..."
count))
count drv)))
(_
(format port (info (G_ "building ~a...")) drv))))
(newline port))
(('build-succeeded drv . _)
(when (or print-log? (not (extended-build-trace-supported?)))

560
guix/swh.scm Normal file
View File

@ -0,0 +1,560 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 (guix swh)
#:use-module (guix base16)
#:use-module (guix build utils)
#:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module (web client)
#:use-module (web response)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen)
#:use-module ((ice-9 ftw) #:select (scandir))
#:export (origin?
origin-id
origin-type
origin-url
origin-visits
lookup-origin
visit?
visit-date
visit-origin
visit-url
visit-snapshot-url
visit-status
visit-number
visit-snapshot
branch?
branch-name
branch-target
release?
release-id
release-name
release-message
release-target
revision?
revision-id
revision-date
revision-directory
lookup-revision
lookup-origin-revision
content?
content-checksums
content-data-url
content-length
lookup-content
directory-entry?
directory-entry-name
directory-entry-type
directory-entry-checksums
directory-entry-length
directory-entry-permissions
lookup-directory
directory-entry-target
save-reply?
save-reply-origin-url
save-reply-origin-type
save-reply-request-date
save-reply-request-status
save-reply-task-status
save-origin
save-origin-status
vault-reply?
vault-reply-id
vault-reply-fetch-url
vault-reply-object-id
vault-reply-object-type
vault-reply-progress-message
vault-reply-status
query-vault
request-cooking
vault-fetch
swh-download))
;;; Commentary:
;;;
;;; This module provides bindings to the HTTP interface of Software Heritage.
;;; It allows you to browse the archive, look up revisions (such as SHA1
;;; commit IDs), "origins" (code hosting URLs), content (files), etc. See
;;; <https://archive.softwareheritage.org/api/> for more information.
;;;
;;; The high-level 'swh-download' procedure allows you to download a Git
;;; revision from Software Heritage, provided it is available.
;;;
;;; Code:
(define %swh-base-url
;; Presumably we won't need to change it.
"https://archive.softwareheritage.org")
(define (swh-url path . rest)
(define url
(string-append %swh-base-url path
(string-join rest "/" 'prefix)))
;; Ensure there's a trailing slash or we get a redirect.
(if (string-suffix? "/" url)
url
(string-append url "/")))
(define-syntax-rule (define-json-reader json->record ctor spec ...)
"Define JSON->RECORD as a procedure that converts a JSON representation,
read from a port, string, or hash table, into a record created by CTOR and
following SPEC, a series of field specifications."
(define (json->record input)
(let ((table (cond ((port? input)
(json->scm input))
((string? input)
(json-string->scm input))
((hash-table? input)
input))))
(let-syntax ((extract-field (syntax-rules ()
((_ table (field key json->value))
(json->value (hash-ref table key)))
((_ table (field key))
(hash-ref table key))
((_ table (field))
(hash-ref table
(symbol->string 'field))))))
(ctor (extract-field table spec) ...)))))
(define-syntax-rule (define-json-mapping rtd ctor pred json->record
(field getter spec ...) ...)
"Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
and define JSON->RECORD as a conversion from JSON to a record of this type."
(begin
(define-record-type rtd
(ctor field ...)
pred
(field getter) ...)
(define-json-reader json->record ctor
(field spec ...) ...)))
(define %date-regexp
;; Match strings like "2014-11-17T22:09:38+01:00" or
;; "2018-09-30T23:20:07.815449+00:00"".
(make-regexp "^([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})((\\.[0-9]+)?)([+-][0-9]{2}):([0-9]{2})$"))
(define (string->date* str)
"Return a SRFI-19 date parsed from STR, a date string as returned by
Software Heritage."
;; We can't use 'string->date' because of the timezone format: SWH returns
;; "+01:00" when the '~z' template expects "+0100". So we roll our own!
(or (and=> (regexp-exec %date-regexp str)
(lambda (match)
(define (ref n)
(string->number (match:substring match n)))
(make-date (let ((ns (match:substring match 8)))
(if ns
(string->number (string-drop ns 1))
0))
(ref 6) (ref 5) (ref 4)
(ref 3) (ref 2) (ref 1)
(+ (* 3600 (ref 9)) ;time zone
(if (< (ref 9) 0)
(- (ref 10))
(ref 10))))))
str)) ;oops!
(define* (call url decode #:optional (method http-get)
#:key (false-if-404? #t))
"Invoke the endpoint at URL using METHOD. Decode the resulting JSON body
using DECODE, a one-argument procedure that takes an input port. When
FALSE-IF-404? is true, return #f upon 404 responses."
(let*-values (((response port)
(method url #:streaming? #t)))
;; See <https://archive.softwareheritage.org/api/#rate-limiting>.
(match (assq-ref (response-headers response) 'x-ratelimit-remaining)
(#f #t)
((? (compose zero? string->number))
(throw 'swh-error url response))
(_ #t))
(cond ((= 200 (response-code response))
(let ((result (decode port)))
(close-port port)
result))
((and false-if-404?
(= 404 (response-code response)))
(close-port port)
#f)
(else
(close-port port)
(throw 'swh-error url response)))))
(define-syntax define-query
(syntax-rules (path)
"Define a procedure that performs a Software Heritage query."
((_ (name args ...) docstring (path components ...)
json->value)
(define (name args ...)
docstring
(call (swh-url components ...) json->value)))))
;; <https://archive.softwareheritage.org/api/1/origin/git/url/https://github.com/guix-mirror/guix/>
(define-json-mapping <origin> make-origin origin?
json->origin
(id origin-id)
(visits-url origin-visits-url "origin_visits_url")
(type origin-type)
(url origin-url))
;; <https://archive.softwareheritage.org/api/1/origin/52181937/visits/>
(define-json-mapping <visit> make-visit visit?
json->visit
(date visit-date "date" string->date*)
(origin visit-origin)
(url visit-url "origin_visit_url")
(snapshot-url visit-snapshot-url "snapshot_url")
(status visit-status)
(number visit-number "visit"))
;; <https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
(define-json-mapping <snapshot> make-snapshot snapshot?
json->snapshot
(branches snapshot-branches "branches" json->branches))
;; This is used for the "branches" field of snapshots.
(define-record-type <branch>
(make-branch name target-type target-url)
branch?
(name branch-name)
(target-type branch-target-type) ;release | revision
(target-url branch-target-url))
(define (json->branches branches)
(hash-map->list (lambda (key value)
(make-branch key
(string->symbol
(hash-ref value "target_type"))
(hash-ref value "target_url")))
branches))
;; <https://archive.softwareheritage.org/api/1/release/1f44934fb6e2cefccbecd4fa347025349fa9ff76/>
(define-json-mapping <release> make-release release?
json->release
(id release-id)
(name release-name)
(message release-message)
(target-type release-target-type "target_type" string->symbol)
(target-url release-target-url "target_url"))
;; <https://archive.softwareheritage.org/api/1/revision/359fdda40f754bbf1b5dc261e7427b75463b59be/>
(define-json-mapping <revision> make-revision revision?
json->revision
(id revision-id)
(date revision-date "date" string->date*)
(directory revision-directory)
(directory-url revision-directory-url "directory_url"))
;; <https://archive.softwareheritage.org/api/1/content/>
(define-json-mapping <content> make-content content?
json->content
(checksums content-checksums "checksums" json->checksums)
(data-url content-data-url "data_url")
(file-type-url content-file-type-url "filetype_url")
(language-url content-language-url "language_url")
(length content-length)
(license-url content-license-url "license_url"))
(define (json->checksums checksums)
(hash-map->list (lambda (key value)
(cons key (base16-string->bytevector value)))
checksums))
;; <https://archive.softwareheritage.org/api/1/directory/27c69c5d298a43096a53affbf881e7b13f17bdcd/>
(define-json-mapping <directory-entry> make-directory-entry directory-entry?
json->directory-entry
(name directory-entry-name)
(type directory-entry-type "type"
(match-lambda
("dir" 'directory)
(str (string->symbol str))))
(checksums directory-entry-checksums "checksums"
(match-lambda
(#f #f)
(lst (json->checksums lst))))
(id directory-entry-id "dir_id")
(length directory-entry-length)
(permissions directory-entry-permissions "perms")
(target-url directory-entry-target-url "target_url"))
;; <https://archive.softwareheritage.org/api/1/origin/save/>
(define-json-mapping <save-reply> make-save-reply save-reply?
json->save-reply
(origin-url save-reply-origin-url "origin_url")
(origin-type save-reply-origin-type "origin_type")
(request-date save-reply-request-date "save_request_date"
string->date*)
(request-status save-reply-request-status "save_request_status"
string->symbol)
(task-status save-reply-task-status "save_task_status"
(match-lambda
("not created" 'not-created)
((? string? str) (string->symbol str)))))
;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
(define-json-mapping <vault-reply> make-vault-reply vault-reply?
json->vault-reply
(id vault-reply-id)
(fetch-url vault-reply-fetch-url "fetch_url")
(object-id vault-reply-object-id "obj_id")
(object-type vault-reply-object-type "obj_type" string->symbol)
(progress-message vault-reply-progress-message "progress_message")
(status vault-reply-status "status" string->symbol))
;;;
;;; RPCs.
;;;
(define-query (lookup-origin url)
"Return an origin for URL."
(path "/api/1/origin/git/url" url)
json->origin)
(define-query (lookup-content hash type)
"Return a content for HASH, of the given TYPE--e.g., \"sha256\"."
(path "/api/1/content"
(string-append type ":"
(bytevector->base16-string hash)))
json->content)
(define-query (lookup-revision id)
"Return the revision with the given ID, typically a Git commit SHA1."
(path "/api/1/revision" id)
json->revision)
(define-query (lookup-directory id)
"Return the directory with the given ID."
(path "/api/1/directory" id)
json->directory-entries)
(define (json->directory-entries port)
(map json->directory-entry (json->scm port)))
(define (origin-visits origin)
"Return the list of visits of ORIGIN, a record as returned by
'lookup-origin'."
(call (swh-url (origin-visits-url origin))
(lambda (port)
(map json->visit (json->scm port)))))
(define (visit-snapshot visit)
"Return the snapshot corresponding to VISIT."
(call (swh-url (visit-snapshot-url visit))
json->snapshot))
(define (branch-target branch)
"Return the target of BRANCH, either a <revision> or a <release>."
(match (branch-target-type branch)
('release
(call (swh-url (branch-target-url branch))
json->release))
('revision
(call (swh-url (branch-target-url branch))
json->revision))))
(define (lookup-origin-revision url tag)
"Return a <revision> corresponding to the given TAG for the repository
coming from URL. Example:
(lookup-origin-release \"https://github.com/guix-mirror/guix/\" \"v0.8\")
=> #<<revision> id: \"44941…\" >
The information is based on the latest visit of URL available. Return #f if
URL could not be found."
(match (lookup-origin url)
(#f #f)
(origin
(match (origin-visits origin)
((visit . _)
(let ((snapshot (visit-snapshot visit)))
(match (and=> (find (lambda (branch)
(string=? (string-append "refs/tags/" tag)
(branch-name branch)))
(snapshot-branches snapshot))
branch-target)
((? release? release)
(release-target release))
((? revision? revision)
revision)
(#f ;tag not found
#f))))
(()
#f)))))
(define (release-target release)
"Return the revision that is the target of RELEASE."
(match (release-target-type release)
('revision
(call (swh-url (release-target-url release))
json->revision))))
(define (directory-entry-target entry)
"If ENTRY, a directory entry, has type 'directory, return its list of
directory entries; if it has type 'file, return its <content> object."
(call (swh-url (directory-entry-target-url entry))
(match (directory-entry-type entry)
('file json->content)
('directory json->directory-entries))))
(define* (save-origin url #:optional (type "git"))
"Request URL to be saved."
(call (swh-url "/api/1/origin/save" type "url" url) json->save-reply
http-post))
(define-query (save-origin-status url type)
"Return the status of a /save request for URL and TYPE (e.g., \"git\")."
(path "/api/1/origin/save" type "url" url)
json->save-reply)
(define-query (query-vault id kind)
"Ask the availability of object ID and KIND to the vault, where KIND is
'directory or 'revision. Return #f if it could not be found, or a
<vault-reply> on success."
;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
;; There's a single format supported for directories and revisions and for
;; now, the "/format" bit of the URL *must* be omitted.
(path "/api/1/vault" (symbol->string kind) id)
json->vault-reply)
(define (request-cooking id kind)
"Request the cooking of object ID and KIND (one of 'directory or 'revision)
to the vault. Return a <vault-reply>."
(call (swh-url "/api/1/vault" (symbol->string kind) id)
json->vault-reply
http-post))
(define* (vault-fetch id kind
#:key (log-port (current-error-port)))
"Return an input port from which a bundle of the object with the given ID
and KIND (one of 'directory or 'revision) can be retrieved, or #f if the
object could not be found.
For a directory, the returned stream is a gzip-compressed tarball. For a
revision, it is a gzip-compressed stream for 'git fast-import'."
(let loop ((reply (query-vault id kind)))
(match reply
(#f
(and=> (request-cooking id kind) loop))
(_
(match (vault-reply-status reply)
('done
;; Fetch the bundle.
(let-values (((response port)
(http-get (swh-url (vault-reply-fetch-url reply))
#:streaming? #t)))
(if (= (response-code response) 200)
port
(begin ;shouldn't happen
(close-port port)
#f))))
('failed
;; Upon failure, we're supposed to try again.
(format log-port "SWH vault: failure: ~a~%"
(vault-reply-progress-message reply))
(format log-port "SWH vault: retrying...~%")
(loop (request-cooking id kind)))
((and (or 'new 'pending) status)
;; Wait until the bundle shows up.
(let ((message (vault-reply-progress-message reply)))
(when (eq? 'new status)
(format log-port "SWH vault: \
requested bundle cooking, waiting for completion...~%"))
(when (string? message)
(format log-port "SWH vault: ~a~%" message))
;; Wait long enough so we don't exhaust our maximum number of
;; requests per hour too fast (as of this writing, the limit is 60
;; requests per hour per IP address.)
(sleep (if (eq? status 'new) 60 30))
(loop (query-vault id kind)))))))))
;;;
;;; High-level interface.
;;;
(define (commit-id? reference)
"Return true if REFERENCE is likely a commit ID, false otherwise---e.g., if
it is a tag name."
(and (= (string-length reference) 40)
(string-every char-set:hex-digit reference)))
(define (call-with-temporary-directory proc) ;FIXME: factorize
"Call PROC with a name of a temporary directory; close the directory and
delete it when leaving the dynamic extent of this call."
(let* ((directory (or (getenv "TMPDIR") "/tmp"))
(template (string-append directory "/guix-directory.XXXXXX"))
(tmp-dir (mkdtemp! template)))
(dynamic-wind
(const #t)
(lambda ()
(proc tmp-dir))
(lambda ()
(false-if-exception (delete-file-recursively tmp-dir))))))
(define (swh-download url reference output)
"Download from Software Heritage a checkout of the Git tag or commit
REFERENCE originating from URL, and unpack it in OUTPUT. Return #t on success
and #f on failure.
This procedure uses the \"vault\", which contains \"cooked\" directories in
the form of tarballs. If the requested directory is not cooked yet, it will
wait until it becomes available, which could take several minutes."
(match (if (commit-id? reference)
(lookup-revision reference)
(lookup-origin-revision url reference))
((? revision? revision)
(call-with-temporary-directory
(lambda (directory)
(let ((input (vault-fetch (revision-directory revision) 'directory))
(tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
(dump-port input tar)
(close-port input)
(let ((status (close-pipe tar)))
(unless (zero? status)
(error "tar extraction failure" status)))
(match (scandir directory)
(("." ".." sub-directory)
(copy-recursively (string-append directory "/" sub-directory)
output
#:log (%make-void-port "w"))
#t))))))
(#f
#f)))

View File

@ -816,6 +816,12 @@ warning."
(warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%")
(/ need 1e6) (/ free 1e6) directory))))
(define (graft-derivation? drv)
"Return true if DRV is definitely a graft derivation, false otherwise."
(match (assq-ref (derivation-properties drv) 'type)
('graft #t)
(_ #f)))
(define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t)
(mode (build-mode normal)))
@ -865,7 +871,11 @@ report what is prerequisites are available for download."
(append-map
substitutable-references
download))))
download)))
download))
((graft build)
(partition (compose graft-derivation?
read-derivation-from-file)
build)))
(define installed-size
(reduce + 0 (map substitutable-nar-size download)))
@ -898,7 +908,12 @@ report what is prerequisites are available for download."
"~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
(length download))
(null? download)
(map substitutable-path download))))
(map substitutable-path download)))
(format (current-error-port)
(N_ "~:[The following graft would be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts would be made:~%~{ ~a~%~}~;~]"
(length graft))
(null? graft) graft))
(begin
(format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
@ -918,7 +933,12 @@ report what is prerequisites are available for download."
"~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
(length download))
(null? download)
(map substitutable-path download)))))
(map substitutable-path download)))
(format (current-error-port)
(N_ "~:[The following graft will be made:~%~{ ~a~%~}~;~]"
"~:[The following grafts will be made:~%~{ ~a~%~}~;~]"
(length graft))
(null? graft) graft)))
(check-available-space installed-size)

View File

@ -565,6 +565,12 @@ static void performOp(bool trusted, unsigned int clientVersion,
case wopSetOptions: {
settings.keepFailed = readInt(from) != 0;
if (isRemoteConnection)
/* When the client is remote, don't keep the failed build tree as
it is presumably inaccessible to the client and could fill up
our disk. */
settings.keepFailed = 0;
settings.keepGoing = readInt(from) != 0;
settings.set("build-fallback", readInt(from) ? "true" : "false");
verbosity = (Verbosity) readInt(from);

View File

@ -16,11 +16,14 @@
# You should have received a copy of the GNU General Public License
# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
EXTRA_DIST = \
%D%/guix-manual.pot \
DOC_PO_FILES= \
%D%/guix-manual.de.po \
%D%/guix-manual.fr.po
EXTRA_DIST = \
%D%/guix-manual.pot \
$(DOC_PO_FILES)
POT_OPTIONS = --package-name "guix" --package-version "$(VERSION)" \
--copyright-holder "Ludovic Courtès" \
--msgid-bugs-address "ludo@gnu.org"
@ -58,3 +61,8 @@ doc-pot-update:
done
msgcat $(addprefix $(srcdir)/po/doc/, $(TMP_POT_FILES)) > $(srcdir)/po/doc/guix-manual.pot
rm -f $(addprefix $(srcdir)/po/doc/, $(TMP_POT_FILES))
doc-po-update: doc-pot-update
for f in $(DOC_PO_FILES); do \
$(MAKE) "$$f"; \
done

View File

@ -1132,6 +1132,16 @@
((p2 . _)
(string<? p1 p2)))))))))))))
(test-equal "derivation-properties"
(list '() '((type . test)))
(let ((drv1 (build-expression->derivation %store "bar"
'(mkdir %output)))
(drv2 (build-expression->derivation %store "foo"
'(mkdir %output)
#:properties '((type . test)))))
(list (derivation-properties drv1)
(derivation-properties drv2))))
(test-equal "map-derivation"
"hello"
(let* ((joke (package-derivation %store guile-1.8))

View File

@ -476,7 +476,15 @@
(return (and (string=? (readlink (string-append out "/foo")) guile)
(string=? (readlink out2) file)
(equal? refs (list (dirname (dirname guile))))
(equal? refs2 (list file))))))
(equal? refs2 (list file))
(null? (derivation-properties drv))))))
(test-assertm "gexp->derivation properties"
(mlet %store-monad ((drv (gexp->derivation "foo"
#~(mkdir #$output)
#:properties '((type . test)))))
(return (equal? '((type . test))
(derivation-properties drv)))))
(test-assertm "gexp->derivation vs. grafts"
(mlet* %store-monad ((graft? (set-grafting #f))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -51,7 +51,8 @@
(test-begin "grafts")
(test-assert "graft-derivation, grafted item is a direct dependency"
(test-equal "graft-derivation, grafted item is a direct dependency"
'((type . graft) (graft (count . 2)))
(let* ((build `(begin
(mkdir %output)
(chdir %output)
@ -76,14 +77,16 @@
(origin %mkdir)
(replacement two))))))
(and (build-derivations %store (list grafted))
(let ((two (derivation->output-path two))
(let ((properties (derivation-properties grafted))
(two (derivation->output-path two))
(grafted (derivation->output-path grafted)))
(and (string=? (format #f "foo/~a/bar" two)
(call-with-input-file (string-append grafted "/text")
get-string-all))
(string=? (readlink (string-append grafted "/sh")) one)
(string=? (readlink (string-append grafted "/self"))
grafted))))))
grafted)
properties)))))
(test-assert "graft-derivation, grafted item uses a different name"
(let* ((build `(begin

View File

@ -157,6 +157,15 @@
(close-inferior inferior)
result))
(test-equal "inferior-eval-with-store"
(add-text-to-store %store "foo" "Hello, world!")
(let* ((inferior (open-inferior %top-builddir
#:command "scripts/guix")))
(inferior-eval-with-store inferior %store
'(lambda (store)
(add-text-to-store store "foo"
"Hello, world!")))))
(test-equal "inferior-package-derivation"
(map derivation-file-name
(list (package-derivation %store %bootstrap-guile "x86_64-linux")