Merge branch 'master' into security-updates

7 files changed, 426 insertions, 59 deletions

diff --git a/guix/build-system/ant.scm b/guix/build-system/ant.scm
new file mode 100644
index 0000000000..d3054e5ffa
--- /dev/null
+++ b/guix/build-system/ant.scm
@@ -0,0 +1,149 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; 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 build-system ant)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix search-paths)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:export (%ant-build-system-modules
+            ant-build
+            ant-build-system))
+
+;; Commentary:
+;;
+;; Standard build procedure for Java packages using Ant.
+;;
+;; Code:
+
+(define %ant-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build ant-build-system)
+    (guix build syscalls)
+    ,@%gnu-build-system-modules))
+
+(define (default-jdk)
+  "Return the default JDK package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((jdk-mod (resolve-interface '(gnu packages java))))
+    (module-ref jdk-mod 'icedtea)))
+
+(define (default-ant)
+  "Return the default Ant package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((jdk-mod (resolve-interface '(gnu packages java))))
+    (module-ref jdk-mod 'ant)))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (jdk (default-jdk))
+                (ant (default-ant))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:source #:target #:jdk #:ant #:inputs #:native-inputs))
+
+  (and (not target)                               ;XXX: no cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs
+
+                        ;; Keep the standard inputs of 'gnu-build-system'.
+                        ,@(standard-packages)))
+         (build-inputs `(("jdk" ,jdk "jdk")
+                         ("ant" ,ant)
+                         ,@native-inputs))
+         (outputs outputs)
+         (build ant-build)
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (ant-build store name inputs
+                    #:key
+                    (tests? #t)
+                    (test-target "tests")
+                    (configure-flags ''())
+                    (make-flags ''())
+                    (build-target "jar")
+                    (jar-name #f)
+                    (phases '(@ (guix build ant-build-system)
+                                %standard-phases))
+                    (outputs '("out"))
+                    (search-paths '())
+                    (system (%current-system))
+                    (guile #f)p
+                    (imported-modules %ant-build-system-modules)
+                    (modules '((guix build ant-build-system)
+                               (guix build utils))))
+  "Build SOURCE with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (ant-build #:name ,name
+                  #:source ,(match (assoc-ref inputs "source")
+                              (((? derivation? source))
+                               (derivation->output-path source))
+                              ((source)
+                               source)
+                              (source
+                               source))
+                  #:make-flags ,make-flags
+                  #:configure-flags ,configure-flags
+                  #:system ,system
+                  #:tests? ,tests?
+                  #:test-target ,test-target
+                  #:build-target ,build-target
+                  #:jar-name ,jar-name
+                  #:phases ,phases
+                  #:outputs %outputs
+                  #:search-paths ',(map search-path-specification->sexp
+                                        search-paths)
+                  #:inputs %build-inputs)))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                               ; the default
+       (let* ((distro (resolve-interface '(gnu packages commencement)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system #:graft? #f)))))
+
+  (build-expression->derivation store name builder
+                                #:inputs inputs
+                                #:system system
+                                #:modules imported-modules
+                                #:outputs outputs
+                                #:guile-for-build guile-for-build))
+
+(define ant-build-system
+  (build-system
+    (name 'ant)
+    (description "The standard Ant build system")
+    (lower lower)))
+
+;;; ant.scm ends here
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
new file mode 100644
index 0000000000..d302b948b5
--- /dev/null
+++ b/guix/build/ant-build-system.scm
@@ -0,0 +1,160 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; 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 build ant-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (sxml simple)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%standard-phases
+            ant-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the standard build procedure for Java packages using
+;; Ant.
+;;
+;; Code:
+
+(define (default-build.xml jar-name prefix)
+  "Create a simple build.xml with standard targets for Ant."
+  (call-with-output-file "build.xml"
+    (lambda (port)
+      (sxml->xml
+       `(project (@ (basedir "."))
+                 (property (@ (name "classes.dir")
+                              (value "${basedir}/build/classes")))
+                 (property (@ (name "jar.dir")
+                              (value "${basedir}/build/jar")))
+                 (property (@ (name "dist.dir")
+                              (value ,prefix)))
+
+                 ;; respect the CLASSPATH environment variable
+                 (property (@ (name "build.sysclasspath")
+                              (value "first")))
+                 (property (@ (environment "env")))
+                 (path (@ (id "classpath"))
+                       (pathelement (@ (location "${env.CLASSPATH}"))))
+
+                 (target (@ (name "compile"))
+                         (mkdir (@ (dir "${classes.dir}")))
+                         (javac (@ (includeantruntime "false")
+                                   (srcdir "src")
+                                   (destdir "${classes.dir}")
+                                   (classpath (@ (refid "classpath"))))))
+
+                 (target (@ (name "jar")
+                            (depends "compile"))
+                         (mkdir (@ (dir "${jar.dir}")))
+                         ;; We cannot use the simpler "jar" task here, because
+                         ;; there is no way to disable generation of a
+                         ;; manifest.  We do not include a generated manifest
+                         ;; to ensure determinism, because we cannot easily
+                         ;; reset the ctime/mtime before creating the archive.
+                         (exec (@ (executable "jar"))
+                               (arg (@ (line ,(string-append "-Mcf ${jar.dir}/" jar-name
+                                                             " -C ${classes.dir} ."))))))
+
+                 (target (@ (name "install"))
+                         (copy (@ (todir "${dist.dir}"))
+                               (fileset (@ (dir "${jar.dir}"))
+                                        (include (@ (name "**/*.jar")))))))
+       port)))
+  (utime "build.xml" 0 0)
+  #t)
+
+(define (generate-classpath inputs)
+  "Return a colon-separated string of full paths to jar files found among the
+INPUTS."
+  (string-join
+   (apply append (map (match-lambda
+                        ((_ . dir)
+                         (find-files dir "\\.*jar$")))
+                      inputs)) ":"))
+
+(define* (configure #:key inputs outputs (jar-name #f)
+                    #:allow-other-keys)
+  (when jar-name
+    (default-build.xml jar-name
+                       (string-append (assoc-ref outputs "out")
+                                      "/share/java")))
+  (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
+  (setenv "CLASSPATH" (generate-classpath inputs)))
+
+(define* (build #:key (make-flags '()) (build-target "jar")
+                #:allow-other-keys)
+  (zero? (apply system* `("ant" ,build-target ,@make-flags))))
+
+(define* (strip-jar-timestamps #:key outputs
+                 #:allow-other-keys)
+  "Unpack all jar archives, reset the timestamp of all contained files, and
+repack them.  This is necessary to ensure that archives are reproducible."
+  (define (repack-archive jar)
+    (format #t "repacking ~a\n" jar)
+    (let ((dir (mkdtemp! "jar-contents.XXXXXX")))
+      (and (with-directory-excursion dir
+             (zero? (system* "jar" "xf" jar)))
+           ;; The manifest file contains timestamps
+           (for-each delete-file (find-files dir "MANIFEST.MF"))
+           (delete-file jar)
+           ;; XXX: copied from (gnu build install)
+           (for-each (lambda (file)
+                       (let ((s (lstat file)))
+                         (unless (eq? (stat:type s) 'symlink)
+                           (utime file 0 0 0 0))))
+                     (find-files dir #:directories? #t))
+           (unless (zero? (system* "jar" "-Mcf" jar "-C" dir "."))
+             (error "'jar' failed"))
+           (utime jar 0 0)
+           #t)))
+
+  (every (match-lambda
+           ((output . directory)
+            (every repack-archive (find-files directory "\\.jar$"))))
+         outputs))
+
+(define* (check #:key target (make-flags '()) (tests? (not target))
+                (test-target "check")
+                #:allow-other-keys)
+  (if tests?
+      (zero? (apply system* `("ant" ,test-target ,@make-flags)))
+      (begin
+        (format #t "test suite not run~%")
+        #t)))
+
+(define* (install #:key (make-flags '()) #:allow-other-keys)
+  (zero? (apply system* `("ant" "install" ,@make-flags))))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (replace 'configure configure)
+    (replace 'build build)
+    (replace 'check check)
+    (replace 'install install)
+    (add-after 'install 'strip-jar-timestamps strip-jar-timestamps)))
+
+(define* (ant-build #:key inputs (phases %standard-phases)
+                    #:allow-other-keys #:rest args)
+  "Build the given Java package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; ant-build-system.scm ends here
diff --git a/guix/grafts.scm b/guix/grafts.scm
index af469575db..6bec999ad2 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -189,6 +189,12 @@ available."
     (guard (c ((nix-protocol-error? c)
                ;; As a last resort, build DRV and query the references of the
                ;; build result.
+
+               ;; Warm up the narinfo cache, otherwise each derivation build
+               ;; will result in one HTTP request to get one narinfo, which is
+               ;; much less efficient than fetching them all upfront.
+               (substitution-oracle store (list drv))
+
                (and (build-derivations store (list drv))
                     (map (cut references store <>) items))))
       (references/substitutes store items)))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 2161856c63..25693824ed 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -222,11 +222,14 @@ or if EOF is reached."
 (module-define! (resolve-module '(web client))
                 'shutdown (const #f))
 
-(define* (http-fetch uri #:key port (text? #f) (buffered? #t))
+(define* (http-fetch uri #:key port (text? #f) (buffered? #t)
+                     keep-alive?)
   "Return an input port containing the data at URI, and the expected number of
 bytes available or #f.  If TEXT? is true, the data at URI is considered to be
 textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
-unbuffered port, suitable for use in `filtered-port'.
+unbuffered port, suitable for use in `filtered-port'.  When KEEP-ALIVE? is
+true, send a 'Connection: keep-alive' HTTP header, in which case PORT may be
+reused for future HTTP requests.
 
 Raise an '&http-get-error' condition if downloading fails."
   (let loop ((uri (if (string? uri)
@@ -246,8 +249,10 @@ Raise an '&http-get-error' condition if downloading fails."
                      ;; Try hard to use the API du jour to get an input port.
                      (if (guile-version>? "2.0.7")
                          (http-get uri #:streaming? #t #:port port
+                                   #:keep-alive? #t
                                    #:headers auth-header) ; 2.0.9+
                          (http-get* uri #:decode-body? text?        ; 2.0.7
+                                    #:keep-alive? #t
                                     #:port port #:headers auth-header)))
                     ((code)
                      (response-code resp)))
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index e999cce1fd..8f0cb7decd 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +22,7 @@
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix utils)
+  #:use-module (guix grafts)
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (gnu packages)
@@ -274,19 +275,23 @@ Report the size of PACKAGE and its dependencies.\n"))
          (leave (_ "missing store item argument\n")))
         ((file)
          (leave-on-EPIPE
-          (with-store store
-            (set-build-options store
-                               #:use-substitutes? #t
-                               #:substitute-urls urls)
+          ;; Turn off grafts because (1) hydra.gnu.org does not serve grafted
+          ;; packages, and (2) they do not make any difference on the
+          ;; resulting size.
+          (parameterize ((%graft? #f))
+            (with-store store
+              (set-build-options store
+                                 #:use-substitutes? #t
+                                 #:substitute-urls urls)
 
-            (run-with-store store
-              (mlet* %store-monad ((item    (ensure-store-item file))
-                                   (profile (store-profile item)))
-                (if map-file
-                    (begin
-                      (profile->page-map profile map-file)
-                      (return #t))
-                    (display-profile* profile)))
-              #:system system))))
+              (run-with-store store
+                (mlet* %store-monad ((item    (ensure-store-item file))
+                                     (profile (store-profile item)))
+                  (if map-file
+                      (begin
+                        (profile->page-map profile map-file)
+                        (return #t))
+                      (display-profile* profile)))
+                #:system system)))))
         ((files ...)
          (leave (_ "too many arguments\n")))))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index b057e9b12a..524d453ffa 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -164,10 +164,9 @@ again."
         (sigaction SIGALRM SIG_DFL)
         (apply values result)))))
 
-(define* (fetch uri #:key (buffered? #t) (timeout? #t) (quiet-404? #f))
+(define* (fetch uri #:key (buffered? #t) (timeout? #t))
   "Return a binary input port to URI and the number of bytes it's expected to
-provide.  If QUIET-404? is true, HTTP 404 error conditions are passed through
-to the caller without emitting an error message."
+provide."
   (case (uri-scheme uri)
     ((file)
      (let ((port (open-file (uri-path uri)
@@ -175,12 +174,10 @@ to the caller without emitting an error message."
        (values port (stat:size (stat port)))))
     ((http https)
      (guard (c ((http-get-error? c)
-                (let ((code (http-get-error-code c)))
-                  (if (and (= code 404) quiet-404?)
-                      (raise c)
-                      (leave (_ "download from '~a' failed: ~a, ~s~%")
-                             (uri->string (http-get-error-uri c))
-                             code (http-get-error-reason c))))))
+                (leave (_ "download from '~a' failed: ~a, ~s~%")
+                       (uri->string (http-get-error-uri c))
+                       (http-get-error-code c)
+                       (http-get-error-reason c))))
        ;; Test this with:
        ;;   sudo tc qdisc add dev eth0 root netem delay 1500ms
        ;; and then cancel with:
@@ -219,19 +216,46 @@ to the caller without emitting an error message."
   (wants-mass-query? cache-info-wants-mass-query?))
 
 (define (download-cache-info url)
-  "Download the information for the cache at URL.  Return a <cache-info>
-object on success, or #f on failure."
-  (define (download url)
-    ;; Download the `nix-cache-info' from URL, and return its contents as an
-    ;; list of key/value pairs.
-    (and=> (false-if-exception (fetch (string->uri url)))
-           fields->alist))
-
-  (and=> (download (string-append url "/nix-cache-info"))
-         (lambda (properties)
-           (alist->record properties
-                          (cut %make-cache-info url <...>)
-                          '("StoreDir" "WantMassQuery")))))
+  "Download the information for the cache at URL.  On success, return a
+<cache-info> object and a port on which to send further HTTP requests.  On
+failure, return #f and #f."
+  (define uri
+    (string->uri (string-append url "/nix-cache-info")))
+
+  (define (read-cache-info port)
+    (alist->record (fields->alist port)
+                   (cut %make-cache-info url <...>)
+                   '("StoreDir" "WantMassQuery")))
+
+  (catch #t
+    (lambda ()
+      (case (uri-scheme uri)
+        ((file)
+         (values (call-with-input-file (uri-path uri)
+                   read-cache-info)
+                 #f))
+        ((http https)
+         (let ((port (open-connection-for-uri uri
+                                              #:timeout %fetch-timeout)))
+           (guard (c ((http-get-error? c)
+                      (warning (_ "while fetching '~a': ~a (~s)~%")
+                               (uri->string (http-get-error-uri c))
+                               (http-get-error-code c)
+                               (http-get-error-reason c))
+                      (close-port port)
+                      (warning (_ "ignoring substitute server at '~s'~%") url)
+                      (values #f #f)))
+             (values (read-cache-info (http-fetch uri
+                                                  #:port port
+                                                  #:keep-alive? #t))
+                     port))))))
+    (lambda (key . args)
+      (case key
+        ((getaddrinfo-error system-error)
+         ;; Silently ignore the error: probably due to lack of network access.
+         (values #f #f))
+        (else
+         (apply throw key args))))))
 
 
 (define-record-type <narinfo>
@@ -480,16 +504,19 @@ may be #f, in which case it indicates that PATH is unavailable at CACHE-URL."
                             ".narinfo")))
     (build-request (string->uri url) #:method 'GET)))
 
-(define (http-multiple-get base-uri proc seed requests)
+(define* (http-multiple-get base-uri proc seed requests
+                            #:key port)
   "Send all of REQUESTS to the server at BASE-URI.  Call PROC for each
 response, passing it the request object, the response, a port from which to
 read the response body, and the previous result, starting with SEED, à la
-'fold'.  Return the final result."
-  (let connect ((requests requests)
+'fold'.  Return the final result.  When PORT is specified, use it as the
+initial connection on which HTTP requests are sent."
+  (let connect ((port     port)
+                (requests requests)
                 (result   seed))
     ;; (format (current-error-port) "connecting (~a requests left)..."
     ;;         (length requests))
-    (let ((p (open-connection-for-uri base-uri)))
+    (let ((p (or port (open-connection-for-uri base-uri))))
       ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
       (when (file-port? p)
         (setvbuf p _IOFBF (expt 2 16)))
@@ -523,7 +550,7 @@ read the response body, and the previous result, starting with SEED, à la
              (match (assq 'connection (response-headers resp))
                (('connection 'close)
                 (close-port p)
-                (connect tail result))            ;try again
+                (connect #f tail result))         ;try again
                (_
                 (loop tail result))))))))))       ;keep going
 
@@ -582,14 +609,17 @@ if file doesn't exist, and the narinfo otherwise."
              (read-to-eof port))
          result))))
 
-  (define (do-fetch uri)
+  (define (do-fetch uri port)
     (case (and=> uri uri-scheme)
       ((http https)
        (let ((requests (map (cut narinfo-request url <>) paths)))
          (update-progress!)
          (let ((result (http-multiple-get uri
                                           handle-narinfo-response '()
-                                          requests)))
+                                          requests
+                                          #:port port)))
+           (unless (port-closed? port)
+             (close-port port))
            (newline (current-error-port))
            result)))
       ((file #f)
@@ -602,17 +632,17 @@ if file doesn't exist, and the narinfo otherwise."
        (leave (_ "~s: unsupported server URI scheme~%")
               (if uri (uri-scheme uri) url)))))
 
-  (define cache-info
-    (download-cache-info url))
-
-  (and cache-info
-       (if (string=? (cache-info-store-directory cache-info)
-                     (%store-prefix))
-           (do-fetch (string->uri url))
-           (begin
-             (warning (_ "'~a' uses different store '~a'; ignoring it~%")
-                      url (cache-info-store-directory cache-info))
-             #f))))
+  (let-values (((cache-info port)
+                (download-cache-info url)))
+    (and cache-info
+         (if (string=? (cache-info-store-directory cache-info)
+                       (%store-prefix))
+             (do-fetch (string->uri url) port)    ;reuse PORT
+             (begin
+               (warning (_ "'~a' uses different store '~a'; ignoring it~%")
+                        url (cache-info-store-directory cache-info))
+               (close-port port)
+               #f)))))
 
 (define (lookup-narinfos cache paths)
   "Return the narinfos for PATHS, invoking the server at CACHE when no
diff --git a/guix/store.scm b/guix/store.scm
index a220b6e6f9..01248738dc 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -726,14 +726,23 @@ error if there is no such root."
              "Return the list of references of PATH."
              store-path-list))
 
+(define %reference-cache
+  ;; Brute-force cache mapping store items to their list of references.
+  ;; Caching matters because when building a profile in the presence of
+  ;; grafts, we keep calling 'graft-derivation', which in turn calls
+  ;; 'references/substitutes' many times with the same arguments.  Ideally we
+  ;; would use a cache associated with the daemon connection instead (XXX).
+  (make-hash-table 100))
+
 (define (references/substitutes store items)
   "Return the list of list of references of ITEMS; the result has the same
 length as ITEMS.  Query substitute information for any item missing from the
 store at once.  Raise a '&nix-protocol-error' exception if reference
 information for one of ITEMS is missing."
   (let* ((local-refs (map (lambda (item)
-                            (guard (c ((nix-protocol-error? c) #f))
-                              (references store item)))
+                            (or (hash-ref %reference-cache item)
+                                (guard (c ((nix-protocol-error? c) #f))
+                                  (references store item))))
                           items))
          (missing    (fold-right (lambda (item local-ref result)
                                    (if local-ref
@@ -757,7 +766,10 @@ the list of references")
                (result      '()))
       (match items
         (()
-         (reverse result))
+         (let ((result (reverse result)))
+           (for-each (cut hash-set! %reference-cache <> <>)
+                     items result)
+           result))
         ((item items ...)
          (match local-refs
            ((#f tail ...)