Re: WIP gnu social package

[ng0 <ng0@n0.is>]

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

nee transcribed 44K bytes:
> Hello, I fixed a bunch of problems I had and now I've been adding
> database migrations when the package version changes.
> This is very insufficiently tested right now.
> I only tested this with one pre-existing installation so far, but it
> seems to work fine there. I want write system tests to cover each case.
....
> After this is done a qvitter package could be added (I never installed
> it before) and maybe the plugins code could be altered to load plugins
> from guix packages.

Qvitter on my server is just a symlinked folder (to a git) into the gnu-social
git folder, with some additional options in config.php. It shouldn't be that
hard, yes.


> I'm appending the patches from my package path, since my website only
> ever displays the latest version.
> 
> Am 25.09.2017 um 23:14 schrieb nee:
> > - Setting up the database requires the sql root password, the new
> >   social_db_user password, and a password for the first admin user to
> >   create in gnu social.
> >   Having plaintext passwords in /etc/config.scm sounds pretty bad.
> >   I'm not sure what the solution here is.
> >   - Could we add a password store to guix? It could automatically
> >     generate passwords and pass them to services.
> >   - Should I generate a script that must be run manually and asks for
> >     password input through stdin?
> >   - Something else?
> > 
> I'm experimenting with the password generator approach right now.
> Current downsides:
> - there is a plaintext file with all the service passwords in /root/
> Positives:
> - It requires no user input for a new installation.
> - It's simple to move with a backup.
> 
> Gnu social needs the password for it's mysql-user to generate the config
> file, so at least this one has to be saved somewhere or entered every
> time you reconfigure.
> 
> I also wrote a new macro 'with-passwords. I'm not very experienced with
> writing macros so it would be nice to get some feedback on it.
> 
> > - The password of the database-user ends up in the config.php which is
> >   generated by mixed-text-file. This file can be read by everyone. Can I
> >   somehow set the owner on it and remove the reading rights from other
> >   users?
> > 
> I moved the config.php file to /var for now, so I can use basic guile
> file writing operations. I have to read up on etc-service-types some day.
> Can these files be created to be not publicly readable by everyone?
> 
> > Here are some other open problems with the packages:
> > 
> > - I build php with --enable-intl now, causes a new broken tests to
> >   appear.
> >   I on a quick look I couldn't figure out what was wrong, and I'm not
> >   familiar with php, so I disabled the failing tests.
> >   Setting the language in gnu social does not seem to work. Nothing
> >   happens, but the installation phase does no longer complain about the
> >   missing php module.
> > 
> Not sure if I tested this wrong, or this was fixed by the php version
> upgrade that happened meanwhile, but now setting the language works.
> Before I log in GNU Social presents itself in the language of my browser.
> After logging in the language from the config.php is used.
> 
> > - A bunch of plugins that are shipped with gs seem to rely on writeable
> >   cache directories in their working directory.
> >   Those can not be changed through the config file.
> >   It will take me some time to find and patch them all.
> > 
> I added a setting to change the cache directory for extlib/HTMLPurifier/
> upstream patch: https://git.gnu.io/gnu/gnu-social/merge_requests/156 (it
> got merged)
> 
> I don't know of any other functions trying to write in the current
> directory right now.
> 
> > - The admin area must be patched out and all configuration options must
> >   be represented by the service.
> > 
> I patched out the link to the Admin menu in the package.
> 
> > - The following plugins throw warnings: Poll, OpenId, Favorite,
> >   Bookmark, DirectMessage those warnings might be related to the
> >   php/mariadb versions used with gnu social
> > 
> > - common warnings that appear:
> >  Warning: Declaration of InviteAction::handle($args) should be
> > compatible with Action::handle() in
> > /gnu/store/qfzqxlfkrzri73jrphlqccsd35s0kcy3-gnu-social-1.2.0-beta4/actions/invite.php
> > on line 298
> > 
> >   Warning: Cannot modify header information - headers already sent by
> > (output started at
> > /gnu/store/qfzqxlfkrzri73jrphlqccsd35s0kcy3-gnu-social-1.2.0-beta4/actions/invite.php:298)
> > in
> > /gnu/store/qfzqxlfkrzri73jrphlqccsd35s0kcy3-gnu-social-1.2.0-beta4/lib/action.php
> > on line 1277
> > 
> > The /settings/poll url completely breaks.
> > 
> These warnings seems to be a general GNU Social problem unrelated to
> guix. When php-fpm is set to not send warnings to the browser it looks
> like any other installation.

> ;;; GNU Guix --- Functional package management for GNU
> ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
> ;;; Copyright © 2016 Marius Bakke <mbakke@fastmail.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 (hidamari-blue php)
>   #:use-module (gnu packages)
>   #:use-module (gnu packages algebra)
>   #:use-module (gnu packages aspell)
>   #:use-module (gnu packages base)
>   #:use-module (gnu packages bison)
>   #:use-module (gnu packages compression)
>   #:use-module (gnu packages curl)
>   #:use-module (gnu packages cyrus-sasl)
>   #:use-module (gnu packages databases)
>   #:use-module (gnu packages fontutils)
>   #:use-module (gnu packages gd)
>   #:use-module (gnu packages gettext)
>   #:use-module (gnu packages glib)
>   #:use-module (gnu packages gnupg)
>   #:use-module (gnu packages image)
>   #:use-module (gnu packages icu4c)
>   #:use-module (gnu packages linux)
>   #:use-module (gnu packages multiprecision)
>   #:use-module (gnu packages openldap)
>   #:use-module (gnu packages pcre)
>   #:use-module (gnu packages pkg-config)
>   #:use-module (gnu packages readline)
>   #:use-module (gnu packages textutils)
>   #:use-module (gnu packages tls)
>   #:use-module (gnu packages web)
>   #:use-module (gnu packages xml)
>   #:use-module (gnu packages xorg)
>   #:use-module (guix packages)
>   #:use-module (guix download)
>   #:use-module (guix build-system gnu)
>   #:use-module ((guix licenses) #:prefix license:))
> 
> (define-public php
>   (package
>     (name "php")
>     (version "7.1.9")
>     (home-page "https://secure.php.net/")
>     (source (origin
>               (method url-fetch)
>               (uri (string-append home-page "distributions/"
>                                   name "-" version ".tar.xz"))
>               (sha256
>                (base32
>                 "130y50nawipd12nbs10661vzk8gvy7zsqcsxvj29mwaivm4a777c"))
>               (modules '((guix build utils)))
>               (snippet
>                '(with-directory-excursion "ext"
>                   (for-each delete-file-recursively
>                             ;; Some of the bundled libraries have no proper upstream.
>                             ;; Ideally we'd extract these out as separate packages:
>                             ;;"mbstring/libmbfl"
>                             ;;"date/lib"
>                             ;;"bcmath/libbcmath"
>                             ;;"fileinfo/libmagic" ; This is a patched version of libmagic.
>                             '("gd/libgd"
>                               "mbstring/oniguruma"
>                               "pcre/pcrelib"
>                               "sqlite3/libsqlite"
>                               "xmlrpc/libxmlrpc"
>                               "zip/lib"))))))
>     (build-system gnu-build-system)
>     (arguments
>      '(#:configure-flags
>        (let-syntax ((with (syntax-rules ()
>                             ((_ option input)
>                              (string-append option "="
>                                             (assoc-ref %build-inputs input))))))
>          (list (with "--with-bz2" "bzip2")
>                (with "--with-curl" "curl")
>                (with "--with-freetype-dir" "freetype")
>                (with "--with-gd" "gd")
>                (with "--with-gdbm" "gdbm")
>                (with "--with-gettext" "glibc") ; libintl.h
>                (with "--with-gmp" "gmp")
> 	       (with "--with-icu-dir" "icu4c")
>                (with "--with-jpeg-dir" "libjpeg")
>                (with "--with-ldap" "openldap")
>                (with "--with-ldap-sasl" "cyrus-sasl")
>                (with "--with-libzip" "zip")
>                (with "--with-libxml-dir" "libxml2")
>                (with "--with-onig" "oniguruma")
>                (with "--with-pcre-dir" "pcre")
>                (with "--with-pcre-regex" "pcre")
>                (with "--with-pdo-pgsql" "postgresql")
>                (with "--with-pdo-sqlite" "sqlite")
>                (with "--with-pgsql" "postgresql")
>                (with "--with-png-dir" "libpng")
>                ;; PHP’s Pspell extension, while retaining its current name,
>                ;; now uses the Aspell library.
>                (with "--with-pspell" "aspell")
>                (with "--with-readline" "readline")
>                (with "--with-sqlite3" "sqlite")
>                (with "--with-tidy" "tidy")
>                (with "--with-webp-dir" "libwebp")
>                (with "--with-xpm-dir" "libxpm")
>                (with "--with-xsl" "libxslt")
>                (with "--with-zlib-dir" "zlib")
>                ;; We could add "--with-snmp", but it requires netsnmp that
>                ;; we don't have a package for. It is used to build the snmp
>                ;; extension of php.
>                "--with-iconv"
>                "--with-openssl"
>                "--with-mysqli"          ; Required for, e.g. wordpress
>                "--with-pdo-mysql"
>                "--with-zlib"
>                "--enable-calendar"
>                "--enable-dba=shared"
>                "--enable-exif"
>                "--enable-flatfile"
>                "--enable-fpm"
>                "--enable-ftp"
>                "--enable-inifile"
> 	       "--enable-intl"	; uses icu4c. Required for, e.g. GNU Social
>                "--enable-mbstring"
>                "--enable-pcntl"
>                "--enable-sockets"))
>        #:phases
>        (modify-phases %standard-phases
>          (add-after 'unpack 'do-not-record-build-flags
>            (lambda _
>              ;; Prevent configure flags from being stored and causing
>              ;; unnecessary runtime dependencies.
>              (substitute* "scripts/php-config.in"
>                (("@CONFIGURE_OPTIONS@") "")
>                (("@PHP_LDFLAGS@") ""))
>              ;; This file has ISO-8859-1 encoding.
>              (with-fluids ((%default-port-encoding "ISO-8859-1"))
>                (substitute* "main/build-defs.h.in"
>                  (("@CONFIGURE_COMMAND@") "(omitted)")))
>              #t))
>          (add-before 'build 'patch-/bin/sh
>            (lambda _
>              (substitute* '("run-tests.php" "ext/standard/proc_open.c")
>                (("/bin/sh") (which "sh")))
>              #t))
>          (add-before 'check 'prepare-tests
>            (lambda _
>              ;; Some of these files have ISO-8859-1 encoding, whereas others
>              ;; use ASCII, so we can't use a "catch-all" find-files here.
>              (with-fluids ((%default-port-encoding "ISO-8859-1"))
>                (substitute* '("ext/mbstring/tests/mb_send_mail02.phpt"
>                               "ext/mbstring/tests/mb_send_mail04.phpt"
>                               "ext/mbstring/tests/mb_send_mail05.phpt"
>                               "ext/mbstring/tests/mb_send_mail06.phpt")
>                  (("/bin/cat") (which "cat"))))
>              (substitute* '("ext/mbstring/tests/mb_send_mail01.phpt"
>                             "ext/mbstring/tests/mb_send_mail03.phpt"
>                             "ext/mbstring/tests/bug52861.phpt"
>                             "ext/standard/tests/general_functions/bug34794.phpt"
>                             "ext/standard/tests/general_functions/bug44667.phpt"
>                             "ext/standard/tests/general_functions/proc_open.phpt")
>                (("/bin/cat") (which "cat")))
> 
>              ;; The encoding of this file is not recognized, so we simply drop it.
>              (delete-file "ext/mbstring/tests/mb_send_mail07.phpt")
> 
>              (substitute* "ext/standard/tests/streams/bug60602.phpt"
>                (("'ls'") (string-append "'" (which "ls") "'")))
> 
>              ;; Drop tests that are known to fail.
>              (for-each delete-file
>                        '("ext/posix/tests/posix_getgrgid.phpt"    ; Requires /etc/group.
>                          "ext/sockets/tests/bug63000.phpt"        ; Fails to detect OS.
>                          "ext/sockets/tests/socket_shutdown.phpt" ; Requires DNS.
>                          "ext/sockets/tests/socket_send.phpt"     ; Likewise.
>                          "ext/sockets/tests/mcast_ipv4_recv.phpt" ; Requires multicast.
>                          ;; These needs /etc/services.
>                          "ext/standard/tests/general_functions/getservbyname_basic.phpt"
>                          "ext/standard/tests/general_functions/getservbyport_basic.phpt"
>                          "ext/standard/tests/general_functions/getservbyport_variation1.phpt"
>                          ;; And /etc/protocols.
>                          "ext/standard/tests/network/getprotobyname_basic.phpt"
>                          "ext/standard/tests/network/getprotobynumber_basic.phpt"
>                          ;; And exotic locales.
>                          "ext/standard/tests/strings/setlocale_basic1.phpt"
>                          "ext/standard/tests/strings/setlocale_basic2.phpt"
>                          "ext/standard/tests/strings/setlocale_basic3.phpt"
>                          "ext/standard/tests/strings/setlocale_variation1.phpt"
> 
> 			 ;; --enable-intl tests that fail, maybe also because of exotic locales?
> 			 "ext/intl/tests/bug74230.phpt"
> 			 "ext/intl/tests/spoofchecker_001.phpt"
> 			 "ext/intl/tests/timezone_IDforWindowsID_basic.phpt"
> 			 "ext/intl/tests/timezone_windowsID_basic.phpt"
> 
> 
>                          ;; XXX: These gd tests fails.  Likely because our version
>                          ;; is different from the (patched) bundled one.
>                          ;; Here, gd quits immediately after "fatal libpng error"; while the
>                          ;; test expects it to additionally return a "setjmp" error and warning.
>                          "ext/gd/tests/bug39780_extern.phpt"
>                          "ext/gd/tests/libgd00086_extern.phpt"
>                          ;; Extra newline in gd-png output.
>                          "ext/gd/tests/bug45799.phpt"
>                          ;; Different error message than expected from imagecrop().
>                          "ext/gd/tests/bug66356.phpt"
>                          ;; Similarly for imagecreatefromgd2().
>                          "ext/gd/tests/bug72339.phpt"
>                          ;; Call to undefined function imageantialias().  They are
>                          ;; supposed to fail anyway.
>                          "ext/gd/tests/bug72482.phpt"
>                          "ext/gd/tests/bug72482_2.phpt"
>                          "ext/gd/tests/bug73213.phpt"
>                          ;; Test expects generic "gd warning" but gets the actual function name.
>                          "ext/gd/tests/createfromwbmp2_extern.phpt"
>                          ;; TODO: Enable these when libgd is built with xpm support.
>                          "ext/gd/tests/xpm2gd.phpt"
>                          "ext/gd/tests/xpm2jpg.phpt"
>                          "ext/gd/tests/xpm2png.phpt"
> 
>                          ;; XXX: These iconv tests have the expected outcome,
>                          ;; but with different error messages.
>                          ;; Expects "illegal character", instead gets "unknown error (84)".
>                          "ext/iconv/tests/bug52211.phpt"
>                          ;; Expects "wrong charset", gets unknown error (22).
>                          "ext/iconv/tests/iconv_mime_decode_variation3.phpt"
>                          "ext/iconv/tests/iconv_strlen_error2.phpt"
>                          "ext/iconv/tests/iconv_strlen_variation2.phpt"
>                          "ext/iconv/tests/iconv_substr_error2.phpt"
>                          ;; Expects conversion error, gets "error condition Termsig=11".
>                          "ext/iconv/tests/iconv_strpos_error2.phpt"
>                          "ext/iconv/tests/iconv_strrpos_error2.phpt"
>                          ;; Similar, but iterating over multiple values.
>                          ;; iconv breaks the loop after the first error with Termsig=11.
>                          "ext/iconv/tests/iconv_strpos_variation4.phpt"
>                          "ext/iconv/tests/iconv_strrpos_variation3.phpt"
> 
>                          ;; XXX: These test failures appear legitimate, needs investigation.
>                          ;; open_basedir() restriction failure.
>                          "ext/curl/tests/bug61948.phpt"
>                          ;; Expects a false boolean, gets empty array from glob().
>                          "ext/standard/tests/file/bug41655_1.phpt"
>                          "ext/standard/tests/file/glob_variation5.phpt"
>                          ;; Test output is correct, but in wrong order.
>                          "ext/standard/tests/streams/proc_open_bug64438.phpt"
>                          ;; The test expects an Array, but instead get the contents(?).
>                          "ext/gd/tests/bug43073.phpt"
>                          ;; imagettftext() returns wrong coordinates.
>                          "ext/gd/tests/bug48732-mb.phpt"
>                          "ext/gd/tests/bug48732.phpt"
>                          ;; Similarly for imageftbbox().
>                          "ext/gd/tests/bug48801-mb.phpt"
>                          "ext/gd/tests/bug48801.phpt"
>                          ;; Different expected output from imagecolorallocate().
>                          "ext/gd/tests/bug53504.phpt"
>                          ;; Wrong image size after scaling an image.
>                          "ext/gd/tests/bug73272.phpt"
>                          ;; Expects iconv to detect illegal characters, instead gets
>                          ;; "unknown error (84)" and heap corruption(!).
>                          "ext/iconv/tests/bug48147.phpt"
>                          ;; Expects illegal character ".", gets "=?utf-8?Q?."
>                          "ext/iconv/tests/bug51250.phpt"
>                          ;; @iconv() does not return expected output.
>                          "ext/iconv/tests/iconv003.phpt"
>                          ;; iconv throws "buffer length exceeded" on some string checks.
>                          "ext/iconv/tests/iconv_mime_encode.phpt"
>                          ;; file_get_contents(): iconv stream filter
>                          ;; ("ISO-8859-1"=>"UTF-8") unknown error.
>                          "ext/standard/tests/file/bug43008.phpt"
>                          ;; Table data not created in sqlite(?).
>                          "ext/pdo_sqlite/tests/bug_42589.phpt"))
> 
>              ;; Skip tests requiring network access.
>              (setenv "SKIP_ONLINE_TESTS" "1")
>              ;; Without this variable, 'make test' passes regardless of failures.
>              (setenv "REPORT_EXIT_STATUS" "1")
>              #t)))
>        #:test-target "test"))
>     (inputs
>      `(("aspell" ,aspell)
>        ("bzip2" ,bzip2)
>        ("curl" ,curl)
>        ("cyrus-sasl" ,cyrus-sasl)
>        ("freetype" ,freetype)
>        ("gd" ,gd)
>        ("gdbm" ,gdbm)
>        ("glibc" ,glibc)
>        ("gmp" ,gmp)
>        ("gnutls" ,gnutls)
>        ("icu4c" ,icu4c)
>        ("libgcrypt" ,libgcrypt)
>        ("libjpeg" ,libjpeg)
>        ("libpng" ,libpng)
>        ("libwebp" ,libwebp)
>        ("libxml2" ,libxml2)
>        ("libxpm" ,libxpm)
>        ("libxslt" ,libxslt)
>        ("libx11" ,libx11)
>        ("oniguruma" ,oniguruma)
>        ("openldap" ,openldap)
>        ("openssl" ,openssl)
>        ("pcre" ,pcre)
>        ("postgresql" ,postgresql)
>        ("readline" ,readline)
>        ("sqlite" ,sqlite)
>        ("tidy" ,tidy)
>        ("zip" ,zip)
>        ("zlib" ,zlib)))
>     (native-inputs
>      `(("pkg-config" ,pkg-config)
>        ("bison" ,bison)
>        ("intltool" ,intltool)
>        ("procps" ,procps)))         ; For tests.
>     (synopsis "PHP programming language")
>     (description
>       "PHP (PHP Hypertext Processor) is a server-side (CGI) scripting
> language designed primarily for web development but is also used as
> a general-purpose programming language.  PHP code may be embedded into
> HTML code, or it can be used in combination with various web template
> systems, web content management systems and web frameworks." )
>     (license (list
>               (license:non-copyleft "file://LICENSE")       ; The PHP license.
>               (license:non-copyleft "file://Zend/LICENSE")  ; The Zend license.
>               license:lgpl2.1                               ; ext/mbstring/libmbfl
>               license:lgpl2.1+                              ; ext/bcmath/libbcmath
>               license:bsd-2                                 ; ext/fileinfo/libmagic
>               license:expat))))                             ; ext/date/lib

> (define-module (hidamari-blue gnu-social)
>   #:use-module (guix utils)
>   #:use-module (guix build utils)
>   #:use-module ((guix licenses) #:prefix license:)
>   #:use-module (guix store)
>   #:use-module (guix packages)
>   #:use-module (guix download)
>   #:use-module (guix git-download)
>   #:use-module (gnu packages web)
>   #:use-module (gnu packages bash)
>   #:use-module (gnu packages gettext)
>   #:use-module (hidamari-blue php)
>   #:use-module (gnu packages databases)
>   #:use-module (guix build-system gnu)
>   #:use-module (guix records)
>   #:use-module (guix gexp)
>   #:use-module (srfi srfi-1)
>   #:use-module (srfi srfi-43)
>   #:use-module (ice-9 match)
> 
>   #:use-module (gnu services)
>   #:use-module (gnu services shepherd)
>   #:use-module (gnu services web)
>   #:use-module (gnu system shadow)
> 
>   #:export (gnu-social-service-type
>             gnu-social-nginx-block
>             gnu-social
> 
>             <gnu-social-config>
>             gnu-social-config
>             make-gnu-social-config
>             gnu-social-config?
> 
>             gnu-social-site-name
>             gnu-social-site-domain
>             gnu-social-site-type
>             gnu-social-avatar-dir
>             gnu-social-attachments-dir
>             gnu-social-pid-dir
>             gnu-social-logfile
>             gnu-social-ssl?
>             gnu-social-db-user
>             gnu-social-password-file
>             gnu-social-db-host
>             gnu-social-db-socket
>             gnu-social-db-database
>             gnu-social-admin-handle
>             gnu-social-admin-email
>             gnu-social-user
>             gnu-social-gnu-social
>             gnu-social-php
>             gnu-social-mysql
>             gnu-social-theme
>             gnu-social-logo
>             gnu-social-timezone
>             gnu-social-language
>             gnu-social-text-limit
>             gnu-social-dupe-limit
>             gnu-social-site-notice))
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;; START OF password stuff
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (define alphanumeric-str "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890")
> (define ascii-special-str "!\"#$%&'()*+,-./:;<=>?[\\]^_`{|}~  ")
> (define (string->vector str) (list->vector (string->list str)))
> (define alphanumeric (string->vector alphanumeric-str))
> (define ascii (string->vector (string-append alphanumeric-str ascii-special-str)))
> 
> (define* (random-string str-length #:optional (alphabet ascii))
>   (call-with-input-file "/dev/urandom"
>     (lambda (port)
>       (define alphabet-max (vector-length alphabet))
>       (define (loop acc i)
> 	(if (< i str-length)
> 	  (cons (floor (/ (get-u8 port) alphabet-max))
> 	   acc)
> 	  (list->string acc)))
>       (loop '() 0))))
> 
> (define (read-password-file file)
>   (if (file-exists? file)
>       (call-with-input-file file
>         (lambda (port)
>           (read port)))
>       (error "Passoword file" file " does not exist.")))
> 
> (define (write-password-file file data)
>   (define data-without-meta
>     (filter (match-lambda 
> 	      (('meta:password-was-generated . x) #f)
> 	      (_ #t))
> 	    data))
>   ;; touch file with limited permissions
>   (call-with-output-file (string-append file ".tmp") (const #t))
>   (chown file 0 0)
>   (chmod file #o600)
>   ;; write
>   (call-with-output-file (string-append file ".tmp")
>     (lambda (port)
>       (write data-without-meta port)))
>   ;; finalize
>   (rename-file (string-append file ".tmp") file))
> 
> (define (optional-password secrets name)
>   (assoc-ref secrets name))
> 
> (define (required-password secrets name)
>   (define found (assoc name secrets))
>   (if found
>       (cdr found)
>       (error "No secret named: " name " in password file.")))
> 
> (define* (generatable-password! secrets name length #:optional (alphabet ascii))
>  (define found (assoc name secrets))
>  (if found
>      (cdr found)
>      (let ((new-password (random-string alphabet)))
>        (set! secrets (cons* (cons name new-password)
> 			    (cons 'meta:password-was-generated #t)
> 			    secrets))
>        new-password)))
> 
> ;;; Example:
> ;; (with-passwords
> ;;  "/root/guix.passwords-store"		; where it will be stored
> ;;  ((optional mysql-root-password)	; will be #f if it is not in the file
> ;;   ;; will be generated for 23 alphanumeric characters
> ;;   ;; and written to the file after the body is run.
> ;;   (generatable gnu-social-mysql-password 23 alphanumeric)
> ;;   ;; will throw an error if it is not in the file
> ;;   (required gnu-social-admin-password))	
> ;;  (init-gnu-social config
> ;; 		  mysql-root-password
> ;; 		  gnu-social-mysql-password
> ;; 		  gnu-social-admin-password))
> 
> (define-syntax with-passwords
>   (syntax-rules (optional)
>     ;; entry point
>     ((_ file (bindings ...) body ...)
>      ((lambda (%secrets)
> 	(binding %secrets file (bindings ...) body ...))
>       (read-password-file file)))))
> (define-syntax binding
>   (syntax-rules (optional required generatable)
>     ;; bindings
>     ((binding %secrets file ((optional name) rest ...) body ...)
>      (let ((name (optional-password %secrets 'name)))
>        (binding %secrets file (rest ...) body ...)))
>     ((binding %secrets file ((required name) rest ...)  body ...)
>      (let ((name (required-password %secrets 'name)))
>        (binding %secrets file (rest ...) body ...)))
>     ((binding %secrets file ((generatable name length) rest ...) body ...)
>      (let ((name (generatable-password! %secrets 'name length)))
>        (binding %secrets file (rest ...) body ...)))
>     ((binding %secrets file ((generatable name length alphabet) rest ...) body ...)
>      (let ((name (generatable-password! %secrets 'name length alphabet)))
>        (binding %secrets file(rest ...) body ...)))
>     ;; final body
>     ((binding %secrets file () body ...)
>      (let ((result (begin body ...)))
>        ;; write generated passwords before returning the result
>        (when (assoc-ref %secrets 'meta:password-was-generated)
> 	 (write-password-file file %secrets))
>        result))))
> 
> 
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> ;;; END OF password stuff
> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> 
> (define (mysql-database-exists? database)
>   ;;; TODO take mysql service settings
>   (file-exists? (string-append "/var/lib/mysql/" database)))
> 
> ;;; 
> 
> ;;; TODO test profilesettings -> openID
> ;;; TODO config for optional different domains for static files
> (define-record-type* <gnu-social-config>
>   gnu-social-config make-gnu-social-config
>   gnu-social-config?
>   ;; --- mandetory during init ---
>   (site-name       gnu-social-site-name
>                    (default "gnu social"))
>   (site-domain     gnu-social-site-domain
>                    (default "localhost"))
>   ;; can be set to single user to change the start page and menues
>   (site-type       gnu-social-site-type
>                    (default "community"))
>   (avatar-dir      gnu-social-avatar-dir
>                    (default "/srv/http/gnu-social/avatar"))
>   (attachments-dir gnu-social-attachments-dir
>                    (default "/srv/http/gnu-social/file"))
>   (pid-dir         gnu-social-pid-dir
>                    (default "/var/gnusocial/pid"))
>   (logfile         gnu-social-logfile
>                    (default #f))
>   (ssl?            gnu-social-ssl?
>                    (default #f))
>   (db-user         gnu-social-db-user
>                    (default "gnusocial"))
>   (password-file   gnu-social-password-file
> 		   (default "/root/guix.password-store"))
>   ;; "localhost" won't work because of mysql.default_socket is incorrectly defined in the php.ini
>   ;; https://stackoverflow.com/questions/1676688/php-mysql-connection-not-working-2002-no-such-file-or-directory#comment48706064_6959675
>   (db-host         gnu-social-db-host
>                    (default "127.0.0.1"))
>   (db-socket       gnu-social-db-socket
>                    (default #f))
>   (db-database     gnu-social-db-database
>                    (default "gnusocial"))
>   (admin-handle    gnu-social-admin-handle
>                    (default "admin"))
>   (admin-email     admin-email
>                    (default "#f"))
>   ;; TODO need a new user for the config file, since that is read by php-fpm
>   (user            gnu-social-user ; system user who owns the writable directories
>                    (default "nginx"))
>   ;; packages
>   (gnu-social      gnu-social-gnu-social
>                    (default gnu-social))
>   (php             gnu-social-php
>                    (default php))
>   (mysql           gnu-social-mysql
>                    (default mariadb))
>   ;; --- optional customizations ---
>   (theme           gnu-social-theme
>                    (default "neo-gnu"))
>   (logo            gnu-social-logo
>                    (default #f))    ; url string
>   (timezone        gnu-social-timezone
>                    (default "UTC"))
>   (language        gnu-social-language
>                    (default "en"))
>   ;; How long notices can be. Set to 0 for unlimited.
>   (text-limit      gnu-social-text-limit
>                    (default 1000))
>   ;; How long users must wait (in seconds) to post the same thing again.
>   (dupe-limit      gnu-social-dupe-limit
>                    (default 60))
>   ;; String to be displayed in the header (max 255 characters).
>   (site-notice     gnu-social-site-notice
>                    (default #f)))
> 
> (define* (gnu-social-nginx-block nginx
>                                  gnu-social
>                                  gnu-social-config
>                                  #:key
>                                  (fastcgi-php-socket "/var/run/php7-fpm.sock")
> 				 (listen '("80" "443 ssl"))
>                                  ;; (https-port #f)
>                                  (ssl-certificate #f)
>                                  (ssl-certificate-key #f)
>                                  (server-tokens? #f))
>   (match-record
>    gnu-social-config
>    <gnu-social-config>
>    (site-domain avatar-dir attachments-dir)
> 
>    (nginx-server-configuration
>     (index (list "index.php"))
>     (server-name (list site-domain))
>     (root (file-append gnu-social "/share/gnu-social"))
>     ;; (http-port http-port)
>     ;; (https-port https-port)
>     (listen listen)
>     (ssl-certificate ssl-certificate)
>     (ssl-certificate-key ssl-certificate-key)
>     (server-tokens? server-tokens?)
>     (locations
>      (list
>       (nginx-location-configuration
>        (uri "~ \\.php$")
>        (body (list
>               "fastcgi_split_path_info ^(.+\\.php)(/.+)$;"
>               (string-append "fastcgi_pass unix:" fastcgi-php-socket ";")
>               "fastcgi_index index.php;"
>               (list "include " nginx "/share/nginx/conf/fastcgi.conf;"))))
>       (nginx-location-configuration
>        (uri "/avatar")
>        (body (list (string-append "alias " avatar-dir ";"))))
>       (nginx-location-configuration
>        (uri "/file")
>        (body (list (string-append "alias " attachments-dir ";"))))
>       (nginx-location-configuration
>        (uri "/scripts")
>        (body (list "deny all;")))
>       ;; not really required, but for my own legacy redirect
>       ;; (nginx-location-configuration
>       ;;  (uri "/index.php/")
>       ;;  (body (list "rewrite ^/index.php/(.*)$ /index.php?p=$1 last")))
>       (nginx-location-configuration
>        (uri "/")
>        (body (list "try_files $uri $uri/ @gnusocial;")))
>       (nginx-named-location-configuration
>        (name "gnusocial")
>        ;; TODO optimize to not use regex
>        ;; (body (list "rewrite ^ /index.php?p=$1 last;"))
>        (body (list "rewrite ^(.*)$ /index.php?p=$1 last;"))))))))
> 
> ;;; TODO defined multiple times (web.scm, telephony.scm)
> (define flatten
>   (lambda (. lst)
>     (define (flatten1 head out)
>       (if (list? head)
>       (fold-right flatten1 out head)
>       (cons head out)))
>     (fold-right flatten1 '() lst)))
> 
> (define-syntax-rule (write-text-file name args ...)
>   (begin
>     (call-with-output-file name
>      (lambda (port)
>        (display (apply string-append (flatten (list args ...))) port)))
>     name))
> 
> (define (write-gnu-social-config-file config db-password)
>   (mkdir-p "/var/gnusocial/config.d/")
>   (match-record
>    config
>    <gnu-social-config>
>    (site-name site-domain site-type avatar-dir attachments-dir pid-dir logfile ssl?
>               db-user db-host db-socket db-database admin-handle admin-email user
>               gnu-social php mysql theme logo timezone language text-limit dupe-limit site-notice)
> 
>    (let* ((mysqli (string-append "mysqli://"
>                                  db-user
>                                  (if db-password
>                                      (string-append ":" db-password)
>                                      "")
>                                  "@" (if db-socket
>                                          (string-append "@unix(" db-socket ")")
>                                          db-host)
>                                  "/" db-database))
> 	  ;; TODO use config variable for php-fpm user
> 	  (gnu-social-user (getpwnam "php-fpm"))
> 	  (config-file (string-append "/var/gnusocial/config.d/"
> 				      site-domain ".php"))
>           (optional (lambda (prefix value suffix)
>                       (if value (string-append prefix value suffix) "")))
> 	  ;; TODO function defined multiple times
> 	  (touch (lambda (file-name)
>                         (call-with-output-file file-name (const #t)))))
> 
>      ;; limit permissions to the config, since it contains the db password
>      ;; owned by root (0), readable by gnu-social's user group
>      (touch config-file)
>      (chown config-file 0 (passwd:gid gnu-social-user))	
>      (chmod config-file #o640)
>      (write-text-file
>       config-file
>       "<?php\n"
>       "if (!defined('GNUSOCIAL')) { exit(1); }\n"
>       "$config['site']['name'] = '" site-name "';\n"
>       "$config['site']['server'] = '" site-domain "';\n"
>       "$config['site']['path'] = false;\n"
>       "$config['site']['fancy'] = true;\n"
>       "$config['site']['ssl'] = '" (if ssl? "always" "never") "';\n"
>       "$config['site']['theme'] = '" theme "';\n"
> 
>       "$config['site']['profile'] = '" site-type "';\n"
>       (optional "$config['site']['logo'] ='" logo "';\n")
>       (optional "$config['site']['timezone'] ='" timezone "';\n")
>       (optional "$config['site']['language'] ='" language "';\n")
>       "$config['site']['textlimit'] =" (number->string text-limit) ";\n"
>       "$config['site']['dupelimit'] =" (number->string dupe-limit) ";\n"
> 
>       "$config['db']['database'] = '" mysqli "';\n"
>       "$config['db']['type'] = 'mysql';\n"
> 
>       "$config['avatar']['dir'] = '" avatar-dir "';\n"
>       "$config['attachments']['dir'] = '" attachments-dir "';\n"
>       "$config['cache']['dir'] = '" "/tmp/" "';\n"
>       "$config['daemon']['piddir'] = '" pid-dir "';\n"
> 
> 
>       "// Uncomment below for better performance. Just remember you must run\n"
>       "// php scripts/checkschema.php whenever your enabled plugins change!\n"
>       "$config['db']['schemacheck'] = 'script';\n"
> 
>       (if logfile
> 	  (string-append "$config['site']['logfile'] = '" logfile "';\n")
> 	  "")))))
> 
> (define gnu-social
>   (let ((commit "50f9f23ff19a4f577c429d80411378d6a1747725"))
>     (package
>      (name "gnu-social")
>      (version "1.2.0-beta4")
>      (source (origin
>               ;; I made some cli-installer patches
>               ;; waiting for them to get accepted into master:
>               ;; https://git.gnu.io/gnu/gnu-social/merge_requests/155
>               (method url-fetch)
>               (uri "https://hidamari.blue/gnu-social.tar.bz2")
>               (sha256
>                (base32
>                 "0l9vh9lxn6d42yh1nfd4ydsrizp7qa018wz9da41a14fd44bwqwi"))
>               ;; (method git-fetch)    ; no tarball available
>               ;; (uri (git-reference
>               ;;       (url "https://git.gnu.io/gnu/gnu-social.git")
>               ;;       (commit commit)))   ; using the latest version
>               ;; (sha256
>               ;;  (base32
>               ;;   "1xja9pbw8dy8jqc44f7z4vd8mrkpcirq1yxxvf4w0lf778z4xasr"))
>               ))
>      (build-system gnu-build-system)
>      (arguments
>       `(#:phases
>         (modify-phases
>          %standard-phases
>          (delete 'configure)
>          (delete 'check)
>          (replace
>           'install
>           (lambda*
>               (#:key outputs #:allow-other-keys)
>             (let ((out (string-append (assoc-ref %outputs "out") "/share/gnu-social/"))
>                   (php-bin (string-append (assoc-ref %build-inputs "php") "/bin/php"))
>                   (bash (string-append (assoc-ref %build-inputs "bash") "/bin/bash")))
> 
>               ;; overwrite the config_files array to only try one config file.
>               (substitute* "lib/gnusocial.php"
>                            (("\\$config_files\\[\\] = INSTALLDIR\\.'/config\\.php';")
>                             "$config_files = array('/var/gnusocial/config.d/'.$_server.'.php');"))
> 
>               (substitute* "lib/installer.php"
>                            (("require_once INSTALLDIR . '/lib/common.php';")
>                             "$server = $this->server; require_once INSTALLDIR . '/lib/common.php'; "))
> 
> 	      (substitute* "lib/primarynav.php"
>                            (("\\$user->hasRight\\(Right::CONFIGURESITE\\)")
>                             "false"))
> 	      
>               (delete-file "install.php")
>               (mkdir-p out)
>               (copy-recursively "." out)
>               #t))))))
> 
>      ;; TODO replace the bundled jquery if someone ever manages to package that juggernaut
>      (inputs `(("php" ,php)
>                ("bash" ,bash)))
>      (native-inputs `(("gettext" ,gnu-gettext)))
>      (home-page "https://gnu.io/social")
>      (synopsis "Federated microblogging platform for the web")
>      (description
>       "GNU Social is a federated microblogging platform.")
>      (license license:agpl3+))))
> 
> (define (gnu-social-activation config)
>   (match-record
>    config
>    <gnu-social-config>
>    (site-name site-domain site-type avatar-dir attachments-dir pid-dir logfile ssl?
>               db-user password-file db-host db-socket db-database admin-handle admin-email user
>               gnu-social php mysql theme logo timezone language text-limit dupe-limit site-notice)
>    
>    (let* ((gnu-social-version (package-version gnu-social))
> 	  ;; TODO put into config
> 	  (installed-version-filepath "/var/gnusocial/version")
> 	  (installed-version (if (file-exists? installed-version-filepath)
> 				 (call-with-input-file installed-version-filepath
> 				   (lambda (port)
> 				     (read port)))
> 				 #f)))
>      (with-passwords
>       password-file
>       ((optional mysql-root-password)
>        (generatable gnu-social-db-password 32)
>        (generatable gnu-social-admin-password 32))
>       #~(begin
> 	  (use-modules (guix build utils)
> 		       (ice-9 match)
> 		       (srfi srfi-1))
> 	  (let ((user (getpwnam #$user))
> 		(sh (string-append #$bash "/bin/sh"))
> 		(php (string-append #$php "/bin/php"))
> 		(mysql (string-append #$mysql "/bin/mysql"))
> 		(install-script (string-append #$gnu-social "/share/gnu-social/scripts/install_cli.php"))
> 		(config-file #$(write-gnu-social-config-file config gnu-social-db-password))
> 		;; TODO remove, since it's already in web.scm, might move to guix utils
> 		(flatten (lambda (. lst)
> 			   (define (flatten1 head out)
> 			     (if (list? head)
> 				 (fold-right flatten1 out head)
> 				 (cons head out)))
> 			   (fold-right flatten1 '() lst)))
> 		(touch (lambda (file-name)
> 			 (call-with-output-file file-name (const #t))))
> 		(write-installed-version
> 		 (lambda ()
> 		   ;; create proof of successful version installation as .tmp
> 		   (call-with-output-file (string-append #$installed-version-filepath ".tmp")
> 		     (lambda (port)
> 		       (write #$gnu-social-version port)))
> 		   ;; rename to actual name
> 		   (rename-file (string-append #$installed-version-filepath ".tmp")
> 				#$installed-version-filepath)
> 		   #t)))
> 	    ;; prepare writable directories
> 	    (mkdir-p #$avatar-dir)
> 	    (mkdir-p #$attachments-dir)
> 	    (chown #$avatar-dir (passwd:uid user) (passwd:gid user))
> 	    (chown #$attachments-dir (passwd:uid user) (passwd:gid user))
> 
> 	    ;; prepare logfile
> 	    (touch #$logfile)
> 	    (chown #$logfile (passwd:uid user) (passwd:gid user))
> 
> 	    (display "wrote gnu-social config ") (display config-file) (newline)
> 
> 	    ;; upgrade/install && check-addon-changes
> 	    (and (cond ((not (equal? #$installed-version #$gnu-social-version))
> 			;; upgrade existing installation
> 			(fromat #t "Upgrading gnu-social database ~a from ~a to ~a."
> 				#$database
> 				#$installed-version #$gnu-social-version)
> 			(and (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/stopdaemons.sh")))
> 			     (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/upgrade.php")
> 					     "--server" #$site-domain))
> 			     (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/startdaemons.sh")))
> 			     (write-installed-version)))
> 		       ((not #$installed-version)
> 			;; inital install
> 			;; create database if it's the default setup
> 			(format "Installing database for gnu social version ~a." #$gnu-social-version)
> 			;; create mysql database and user
> 			(and (zero? (apply system* mysql
> 					   "--execute"
> 					   ;; TODO FIXME escape ' signs in username/password
> 					   (string-append "
> CREATE DATABASE IF NOT EXISTS " #$db-database ";
> CREATE USER IF NOT EXISTS '" #$db-user "'@'localhost' identified by '" #$gnu-social-db-password "';
> GRANT ALL PRIVILEGES ON " #$db-database ".* TO '" #$db-user "'@'localhost';")
> 					   
> 					   "--user" "root"
> 					   (cond (#$db-host (list "--host" #$db-host))
> 						 (#$db-socket (list "--socket" #$db-socket))
> 						 (#t (error "gnu-social-service: "
> 							    "either db-host or db-socket must be set")))
> 					   ;; TODO FIXME SECURITY this will appear in the system's process list
> 					   (if #$mysql-root-password
> 					       (list (string-append "--password=" #$mysql-root-password))
> 					       '())))
> 			     ;; call the install script
> 			     (zero? (apply system* php install-script
> 					   (filter (lambda (x) (or (not (list? x))
> 								   (not (null? x))))
> 						   (flatten
> 						    "--skip-config"
> 						    "--sitename"     #$site-name
> 						    "--server"       #$site-domain
> 						    "--site-profile" #$site-type
> 
> 						    "--dbtype"   "mysql"
> 						    "--host"     #$db-host
> 						    "--database" #$db-database
> 						    "--username" #$db-user
> 						    (if #$gnu-social-db-password
> 							(list "--password" #$gnu-social-db-password)
> 							'())
> 
> 						    "--admin-nick" #$admin-handle
> 						    "--admin-pass" #$gnu-social-admin-password
> 						    (if #$admin-email
> 							(list "--admin-email" #$admin-email)
> 							'())))))
> 			     (write-installed-version)))
> 		       ;; same version already installed, do nothing
> 		       (else #t))
> 		 ;; call the routing update script, in case any new addons were installed
> 		 (zero? (system* php (string-append #$gnu-social "/share/gnu-social/scripts/checkschema.php")
> 				 "--server" #$site-domain)))))))))
> 
> (define gnu-social-service-type
>   (service-type (name 'gnu-social)
>                 (extensions
>                  (list (service-extension activation-service-type
>                                           gnu-social-activation)))))


-- 
GnuPG: A88C8ADD129828D7EAC02E52E22F9BBFEE348588
GnuPG: https://c.n0.is/ng0_pubkeys/tree/keys
  WWW: https://n0.is/a/  ::  https://ea.n0.is

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]