WIP gnu social package

WIP gnu social package

[nee]

Hello, I'm currently trying to package gnu social for GuixSD.

I made a package that builds the translations and installs gnu social
into the store.
I also made a service that sets up the config.php file in the /gnu/store
and generates an /etc/gnu-social/$site-name/config.php link.
The service also has an activation phase in which I run the installer to
setup the mariadb database if it doesn't exist.
Generally it's working, as it installs and you can post things.
For completion it will probably take some time and I came across some
general problems, so I thought I might send a WIP report.



I have been developing it in my GUIX_PACKAGE_PATH and might send parts
like php-fpm to master soon. WIP packages can be seen here:
https://hidamari.blue/git/packages/html/gnu-social.scm.html

   # or clone it, this takes about a minute without any output:
   git clone https://hidamari.blue/git/packages/ hidamari-blue

Here is an example config: http://paste.lisp.org/display/356859



Here are a bunch of issues I have with guixSD in general:

- 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?

- 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?

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.

- 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.

- The admin area must be patched out and all configuration options must
  be represented by the service.

- 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.

Re: WIP gnu social package

[Ludovic Courtès]

Hello,

nee <nee@cock.li> skribis:

> I made a package that builds the translations and installs gnu social
> into the store.

[...]

> Here is an example config: http://paste.lisp.org/display/356859

Really cool that we can set up a complex service like this with just a
few lines!

> Here are a bunch of issues I have with guixSD in general:
>
> - 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?

For this particular case, I would do nothing: the first time, the
service wouldn’t start (I guess).  Users would have to explicitly set
the passwords on the command line, and then run “herd start gnu-social”.

> - 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?

No, the store is world-readable.  If there are secrets, they should be
stored elsewhere, but there’s currently no standard way to do that in
Guix.

Thanks for sharing, and sorry for the late reply!

Ludo’.

Re: WIP gnu social package

[nee]

Hey, I haven't done anything on this lately, but the php-fpm service is
probably getting accepted soon, so I might start working on this again.

Am 05.10.2017 um 17:00 schrieb Ludovic Courtès:
> For this particular case, I would do nothing: the first time, the
> service wouldn’t start (I guess).  Users would have to explicitly set
> the passwords on the command line, and then run “herd start gnu-social”.
> 
The advantage of using a service is the easy setup with mysql and the
gnu-social-cli-installer, otherwise people could just run nginx and
clone gnu social to /srv/gnu-social/ and manually create the database
like you would on Debian.

I saw that NixOS has something called passwordFile.
https://github.com/NixOS/nixpkgs/issues/24288
I haven't found any details about it, but it seems like a text file from
which passwords can be read during `system reconfigure`.

As a start I could add a password-file field to the configuration of
gnu-social and read an alist of passwords from it during initialization.
That could later be extended by generating it with randomized passwords
if it doesn't exist to maximize the ease of installation.

>> - 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?
> 
> No, the store is world-readable.  If there are secrets, they should be
> stored elsewhere, but there’s currently no standard way to do that in
> Guix.
> 
Could a function in guix/gexp.scm be modified to generate a file outside
of the store?

Re: WIP gnu social package

[Ludovic Courtès]

Hello,

nee <nee@cock.li> skribis:

> Am 05.10.2017 um 17:00 schrieb Ludovic Courtès:
>> For this particular case, I would do nothing: the first time, the
>> service wouldn’t start (I guess).  Users would have to explicitly set
>> the passwords on the command line, and then run “herd start gnu-social”.
>> 
> The advantage of using a service is the easy setup with mysql and the
> gnu-social-cli-installer, otherwise people could just run nginx and
> clone gnu social to /srv/gnu-social/ and manually create the database
> like you would on Debian.
>
> I saw that NixOS has something called passwordFile.
> https://github.com/NixOS/nixpkgs/issues/24288
> I haven't found any details about it, but it seems like a text file from
> which passwords can be read during `system reconfigure`.
>
> As a start I could add a password-file field to the configuration of
> gnu-social and read an alist of passwords from it during initialization.
> That could later be extended by generating it with randomized passwords
> if it doesn't exist to maximize the ease of installation.
>
>>> - 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?
>> 
>> No, the store is world-readable.  If there are secrets, they should be
>> stored elsewhere, but there’s currently no standard way to do that in
>> Guix.
>> 
> Could a function in guix/gexp.scm be modified to generate a file outside
> of the store?

We could use Guile’s standard I/O primitives to create files wherever we
like:

  https://www.gnu.org/software/guile/manual/html_node/Input-and-Output.html

and/or simply refer to a non-store file; if that file exists,
everything’s fine, and if it does not, the service might fail to start
or print an error.

Ludo’.

Re: WIP gnu social package

[nee]

[-- Attachment #1: Type: text/plain, Size: 4549 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.

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.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: php.scm --]
[-- Type: text/x-scheme; name="php.scm", Size: 17219 bytes --]

;;; 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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: gnu-social.scm --]
[-- Type: text/x-scheme; name="gnu-social.scm", Size: 23598 bytes --]

(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)))))

Re: WIP gnu social package

[ng0]

[-- 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 --]