Merge branch 'master' into core-updates

tests/guix-daemon.sh

@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -193,3 +193,39 @@ do
     GUIX_DAEMON_SOCKET="$socket" guile -c "$client_code"
     kill "$daemon_pid"
 done
+
+# Log compression.
+
+guix-daemon --listen="$socket" --disable-chroot --debug --log-compression=gzip &
+daemon_pid=$!
+
+stamp="compressed-build-log-test-$$-`date +%H%M%S`"
+client_code="
+  (use-modules (guix) (gnu packages bootstrap))
+
+  (with-store store
+    (run-with-store store
+      (mlet %store-monad ((drv (lower-object
+				(computed-file \"compressed-log-test\"
+					       #~(begin
+						   (display \"$stamp\")
+                                                   (newline)
+						   (mkdir #\$output))
+					       #:guile %bootstrap-guile))))
+	(display (derivation-file-name drv))
+	(newline)
+	(return #t))))
+"
+
+GUIX_DAEMON_SOCKET="$socket"
+export GUIX_DAEMON_SOCKET
+
+drv=`guile -c "$client_code"`
+guix build "$drv"
+
+log=`guix build "$drv" --log-file`
+test -f "$log"
+case "$log" in
+    *.gz) test "`gunzip -c < "$log"`" = "$stamp" ;;
+    *)    false ;;
+esac

tests/publish.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -439,4 +440,31 @@ FileSize: ~a~%"
                          (assoc-ref narinfo "FileSize"))
                         (response-code compressed))))))))))
 
+(test-equal "/log/NAME"
+  `(200 #t application/x-bzip2)
+  (let ((drv (run-with-store %store
+               (gexp->derivation "with-log"
+                                 #~(call-with-output-file #$output
+                                     (lambda (port)
+                                       (display "Hello, build log!"
+                                                (current-error-port))
+                                       (display "" port)))))))
+    (build-derivations %store (list drv))
+    (let* ((response (http-get
+                      (publish-uri (string-append "/log/"
+                                                  (basename (derivation->output-path drv))))
+                      #:decode-body? #f))
+           (base     (basename (derivation-file-name drv)))
+           (log      (string-append (dirname %state-directory)
+                                    "/log/guix/drvs/" (string-take base 2)
+                                    "/" (string-drop base 2) ".bz2")))
+      (list (response-code response)
+            (= (response-content-length response) (stat:size (stat log)))
+            (first (response-content-type response))))))
+
+(test-equal "/log/NAME not found"
+  404
+  (let ((uri (publish-uri "/log/does-not-exist")))
+    (response-code (http-get uri))))
+
 (test-end "publish")