[bug#47495] [PATCH] gnu: vsftpd: Use CentOS version and patches.

[Tobias Geerinckx-Rice via Guix-patches via <guix-patches@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 4739 bytes --]

David,

david larsson writes:
> Hi,
> the attached patch updates vsftpd so it can use tlsv1.2 etc.

Wow.  Thanks!

As indicated on IRC I've made some changes to the patch, mainly to 
avoid hard-coding all patches.  The result is attached.  Let me 
know what you think.

Further random comments below:

>  From: methuselah-0 <david.larsson@selfhosted.xyz>
> Date: Tue, 30 Mar 2021 11:18:09 +0200
> Subject: [PATCH] gnu: vsftpd: Use CentOS version and patches.
>
>      * gnu/packages/ftp.scm (vftpd): Use CentOS version and 
>      patches.
   ^^^^

This is what happens when you copy commit messages from git and 
paste them right back in :-)  In that case, remove the four 
leading spaces.

> +  (let ((version "3.0.3")

I renamed this to UPSTREAM-VERSION, so we can show a more specific 
VERSION field in the Guix UI.  What we offer isn't ‘3.0.3’ any 
more.

> +        (revision "32")

I subjectively added ‘.el8’ here, mainly to factor it out below. 
Neither of us knows what it means, though...

> +           (add-after 'unpack 'patch-installation-directory
> +             (lambda* (#:key outputs #:allow-other-keys)
> +               (substitute* "Makefile"
> +                 (("/usr") (assoc-ref outputs "out")))
> +               #t))

Moved below the redefined 'unpack phase for clarity.

> +           (replace 'unpack
> +             (lambda* (#:key source #:allow-other-keys)
> +                 (let ((version "3.0.3")
> +                       (revision "32")
> +                       (centos-version "8.3.2011"))

OK, so, as mentioned on IRC this can be avoided by quasiquoting 
<arguments> (as it already was, here) and using ,version instead.

Quoting is probably the most confusing-yet-basic concept in 
Scheme.

> +
> +                   (invoke "7z" "e" source (string-append "-o" 
> "./vsftpd-"
> + 
> version "-"
> + 
> revision 
> ".el8.src.cpio"))
> +                   (chdir (string-append "./vsftpd-" version 
> "-"
> +                                         revision 
> ".el8.src.cpio"))
> +                   (invoke "cpio" "-idmv" (string-append 
> "--file=./vsftpd-"
> + 
> version "-"
> + 
> revision 
> ".el8.src.cpio"))
> +                   (invoke "tar" "xvf" (string-append 
> "./vsftpd-" 
> version ".tar.gz"))

This dance had a few steps too many IMO, so I simplified it.  It's 
OK to keep the unpacked steps around during the (short) build 
process; they are tiny by today's standards.

> +                   (let ((patches

I understand the reason for this: the patches need to be applied 
in this order, or patching will appear to succeed but result in 
unbuildable source.  A simple FIND-FILES is right out.

However, since the order is specified in vsftpd.spec, it's safer, 
shorter, and simply more fun to parse it ourselves.

> +                     (chdir (string-append "./vsftpd-" 
> version))
> +                     (invoke "git" "init" ".")
> +                     (invoke "git" "config" "user.email" 
> "you@example.com")
> +                     (invoke "git" "config" "user.name" "Your 
> Name" )
> +                     (invoke "git" "add" ".")
> +                     (invoke "git" "commit" "-m" "first")
> +                     (map (lambda (x) (invoke "git" "am" 
> (string-append 
> "./" x))) patches)
> +                     (map (lambda (x) (invoke "rm" 
> (string-append "./" 
> x))) patches)
> +                     (invoke "rm" "-rf" "./.git")
> +                     (chdir "../")
> +                     (invoke "mv" (string-append "./vsftpd-" 
> version) 
> "../")
> +                     (chdir "../")
> +                     (invoke "rm" "-rf" (string-append 
> "./vsftpd-" 
> version "-"
> +                                                       revision 
> ".el8.src.cpio"))
> +                     (chdir (string-append "./vsftpd-" 
> version)))

You lost me here.  Why all the git?  I removed all mention of git 
from the package, since it didn't seem necessary, but please 
correct me if needful.

> +                   #t)))

Whilst Guix on master still complains about ‘missing’ #Ts, they 
are a moribund relic and I've secretly started forgetting the odd 
#t on master already...

> +      (native-inputs `(("openssl" ,openssl)
> +                       ("linux-pam" ,linux-pam)
> +                       ("p7zip" ,p7zip)
> +                       ("cpio" ,cpio)
> +                       ("git" ,git-minimal)
> +                       ("libcap" ,libcap)))

These are *all* new, correct?  I removed git and added them all to 
the commit message (check it out).

Thanks again for your work!

T G-R


[-- Attachment #2: 0001-gnu-vsftpd-Use-CentOS-version-and-patches.patch --]
[-- Type: text/x-patch, Size: 7138 bytes --]

From 43ca5cf141a61120cf9b02d26394109be75e679f Mon Sep 17 00:00:00 2001
From: methuselah-0 <david.larsson@selfhosted.xyz>
Date: Tue, 30 Mar 2021 11:18:09 +0200
Subject: [PATCH] gnu: vsftpd: Use CentOS version and patches.

* gnu/packages/ftp.scm (vftpd)[source]: Use CentOS source RPM.
[arguments]: Adapt the 'unpack phase, and apply CentOS patches in a new
'apply-CentOS-patches phase.
[native-inputs]: Add openssl, linux-pam, libcap, p7zip, and cpio.
---
 gnu/packages/ftp.scm | 116 +++++++++++++++++++++++++++++--------------
 1 file changed, 80 insertions(+), 36 deletions(-)

diff --git a/gnu/packages/ftp.scm b/gnu/packages/ftp.scm
index b178063556..f3d3c68e5e 100644
--- a/gnu/packages/ftp.scm
+++ b/gnu/packages/ftp.scm
@@ -2,8 +2,9 @@
 ;;; Copyright © 2014, 2015, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016–2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017 Rene Saavedra <rennes@openmailbox.org>
+;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,12 +29,14 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages autotools)
   #:use-module (gnu packages check)
+  #:use-module (gnu packages cpio)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages gtk)
   #:use-module (gnu packages libidn)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages nettle)
   #:use-module (gnu packages pkg-config)
@@ -251,40 +254,81 @@ directory comparison and more.")
     (properties '((upstream-name . "FileZilla")))))
 
 (define-public vsftpd
-  (package
-    (name "vsftpd")
-    (version "3.0.3")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "https://security.appspot.com/downloads/"
-                                  name "-" version ".tar.gz"))
-              (sha256
-               (base32
-                "1xsyjn68k3fgm2incpb3lz2nikffl9by2safp994i272wvv2nkcx"))))
-    (build-system gnu-build-system)
-    (arguments
-     `(#:make-flags '("LDFLAGS=-lcrypt")
-       #:tests? #f                      ; No tests exist.
-       #:phases
-       (modify-phases %standard-phases
-         (add-after 'unpack 'patch-installation-directory
-           (lambda* (#:key outputs #:allow-other-keys)
-             (substitute* "Makefile"
-               (("/usr") (assoc-ref outputs "out")))
-             #t))
-         (add-before 'install 'mkdir
-           (lambda* (#:key outputs #:allow-other-keys)
-             (let ((out (assoc-ref outputs "out")))
-               (mkdir-p out)
-               (mkdir (string-append out "/sbin"))
-               (mkdir (string-append out "/man"))
-               (mkdir (string-append out "/man/man5"))
-               (mkdir (string-append out "/man/man8"))
-               #t)))
-         (delete 'configure))))
-    (synopsis "vsftpd FTP daemon")
-    (description "@command{vsftpd} is a daemon that listens on a TCP socket
+  ;; Use a significantly patched CentOS variant supporting TLSv1.2, ‘email
+  ;; passwords’, and XXX davidl: anything else?
+  (let ((upstream-version "3.0.3")
+        (centos-version "8.3.2011")
+        (revision "32.el8"))
+    (package
+      (name "vsftpd")
+      (version (string-append upstream-version "." revision))
+      (source
+       (origin
+         (method url-fetch)
+         (uri (string-append
+               "https://vault.centos.org/centos/" centos-version
+               "/AppStream/Source/SPackages/vsftpd-" upstream-version "-"
+               revision ".src.rpm"))
+         (sha256
+          (base32 "1xl0kqcismf82hl99klqbvvpylpyk1yr1qjy5hd8f80cj4lyl0f4"))))
+      (build-system gnu-build-system)
+      (arguments
+       `(#:make-flags '("LDFLAGS=-lcrypt -lssl -pie")
+         #:tests? #f                    ; no tests exist
+         #:phases
+         (modify-phases %standard-phases
+           (replace 'unpack
+             (lambda* (#:key source #:allow-other-keys)
+               (invoke "7z" "e" source "-ocpio")
+               (invoke "cpio" "-idmv"
+                       (string-append "--file=cpio/vsftpd-"
+                                      ,upstream-version "-" ,revision
+                                      ".src.cpio"))
+               (invoke "tar" "xvf"
+                       (string-append "vsftpd-" ,upstream-version ".tar.gz"))
+               (chdir (string-append "vsftpd-" ,upstream-version))))
+           (add-after 'unpack 'apply-CentOS-patches
+             ;; Apply all patches as enumerated in vsftpd.spec, in order:
+             ;; simply using FIND-FILES would silently corrupt the result.
+             (lambda _
+               (call-with-input-file "../vsftpd.spec"
+                 (lambda (port)
+                   (use-modules (ice-9 rdelim))
+                   (let loop ()
+                     (let ((line (read-line port)))
+                       (unless (eof-object? line)
+                         (when (string-prefix? "Patch" line)
+                           (let* ((space (string-rindex line #\space))
+                                  (patch (string-drop line (+ 1 space))))
+                             (invoke "patch" "-Np1"
+                                     "-i" (string-append "../" patch))))
+                         (loop))))))))
+           (add-after 'unpack 'patch-installation-directory
+             (lambda* (#:key outputs #:allow-other-keys)
+               (substitute* "Makefile"
+                 (("/usr") (assoc-ref outputs "out")))
+               #t))
+           (add-before 'install 'mkdir
+             (lambda* (#:key outputs #:allow-other-keys)
+               (let ((out (assoc-ref outputs "out")))
+                 (mkdir-p out)
+                 (mkdir (string-append out "/sbin"))
+                 (mkdir (string-append out "/man"))
+                 (mkdir (string-append out "/man/man5"))
+                 (mkdir (string-append out "/man/man8"))
+                 #t)))
+           (delete 'configure))))
+      (native-inputs
+       `(("openssl" ,openssl)
+         ("linux-pam" ,linux-pam)
+         ("libcap" ,libcap)
+
+         ;; Used to unpack the source RPM.
+         ("p7zip" ,p7zip)
+         ("cpio" ,cpio)))
+      (home-page "https://security.appspot.com/vsftpd.html")
+      (synopsis "Share files securely over FTP or FTPS")
+      (description "@command{vsftpd} is a daemon that listens on a TCP socket
 for clients and gives them access to local files via File Transfer
 Protocol.")
-    (home-page "https://security.appspot.com/vsftpd.html")
-    (license gpl2)))
+      (license gpl2))))
-- 
2.30.1