.gitignore

@@ -11,18 +11,32 @@ nytprof*
 www/nytprof
 pm_to_blib
 pod2htmd.tmp
-list.min.json
-highlight.min.js
-obsidian.min.css
+www/scripts/list.min.json
+www/scripts/highlight.min.js
+www/scripts/chart.js
+www/scripts/reveal.js
+www/styles/obsidian.min.css
+www/styles/reveal.css
+www/styles/reveal-white.css
 www/.well_known
 config/auth.db
 config/has_users
 config/main.cfg
 config/setup
+Makefile
 MYMETA.yml
 MYMETA.json
 node_modules/
 www/statics/
 totp/
 nginx/tcms.conf
+fail2ban/tcms-jail.conf
 logs/
+run/
+dns/tcms.conf
+dns/zones.db
+dns/zone.sql
+dns/default.zone
+dns/default.zone.sql
+*-shm
+*-wal

Installer.mk

@@ -0,0 +1,195 @@
+SHELL := /bin/bash
+SERVER_NAME := $(shell bin/tcms-hostname)
+
+.PHONY: depend
+depend:
+	[ -f "/etc/debian_version" ] && make -f Installer.mk prereq-debs; /bin/true;
+	make -f Installer.mk prereq-perl prereq-frontend
+
+.PHONY: install
+install:
+	test -d www/themes || mkdir -p www/themes
+	test -d data/files || mkdir -p data/files
+	test -d www/assets || mkdir -p www/assets
+	test -d www/statics || mkdir -p www/statics
+	test -d totp/ || mkdir -p totp
+	test -d ~/.tcms || mkdir ~/.tcms
+	test -d logs/ && mkdir -p logs/; /bin/true
+	$(RM) pod2htmd.tmp;
+
+.PHONY: install-service
+install-service:
+	mkdir -p ~/.config/systemd/user
+	cp service-files/systemd.unit ~/.config/systemd/user/tCMS.service
+	sed -ie 's#__REPLACEME__#$(shell pwd)#g' ~/.config/systemd/user/tCMS.service
+	systemctl --user daemon-reload
+	systemctl --user enable tCMS
+	systemctl --user start tCMS
+	loginctl enable-linger $(USER)
+
+.PHONY: prereq-debian
+prereq-debian: prereq-debs prereq-perl prereq-frontend prereq-node
+
+.PHONY: prereq-debs
+prereq-debs:
+	sudo apt-get update
+	sudo apt-get install -y sqlite3 nodejs npm libsqlite3-dev libdbd-sqlite3-perl cpanminus starman libxml2 curl cmake \
+		uwsgi uwsgi-plugin-psgi fail2ban nginx certbot postfix dovecot-imapd dovecot-pop3d postgrey spamassassin amavis clamav\
+		opendmarc opendkim opendkim-tools libunbound-dev \
+	    libtext-xslate-perl libplack-perl libconfig-tiny-perl libdatetime-format-http-perl libjson-maybexs-perl          \
+	    libuuid-tiny-perl libcapture-tiny-perl libconfig-simple-perl libdbi-perl libfile-slurper-perl libfile-touch-perl \
+	    libfile-copy-recursive-perl libxml-rss-perl libmodule-install-perl libio-string-perl uuid-dev                    \
+	    libmoose-perl libmoosex-types-datetime-perl libxml-libxml-perl liblist-moreutils-perl libclone-perl libpath-tiny-perl \
+		selinux-utils setools policycoreutils-python-utils policycoreutils selinux-basics auditd \
+		pdns-tools pdns-server pdns-backend-sqlite3 libmagic-dev autotools-dev dh-autoreconf
+
+.PHONY: prereq-perl
+prereq-perl:
+	sudo cpanm -n --installdeps .
+
+.PHONY: prereq-node
+prereq-node:
+	npm i
+
+.PHONY: prereq-frontend
+prereq-frontend:
+	mkdir -p www/scripts; pushd www/scripts && curl -L --remote-name-all                        \
+		"https://raw.githubusercontent.com/chalda-pnuzig/emojis.json/master/dist/list.min.json" \
+		"https://raw.githubusercontent.com/highlightjs/cdn-release/main/build/highlight.min.js" \
+		"https://cdn.jsdelivr.net/npm/chart.js" \
+		"https://github.com/hakimel/reveal.js/blob/master/dist/reveal.js"; popd
+	mkdir -p www/styles; pushd www/styles && curl -L --remote-name-all \
+		"https://raw.githubusercontent.com/highlightjs/cdn-release/main/build/styles/obsidian.min.css" \
+	    "https://raw.githubusercontent.com/hakimel/reveal.js/master/dist/reveal.css" \
+		"https://raw.githubusercontent.com/hakimel/reveal.js/master/dist/theme/white.css"; popd
+	mv www/styles/white.css www/styles/reveal-white.css
+
+.PHONY: reset
+reset: reset-remove install
+
+.PHONY: reset-remove
+reset-remove:
+	rm -rf data; /bin/true
+	rm -rf www/themes; /bin/true
+	rm -rf www/assets; /bin/true
+	rm config/auth.db; /bin/true
+	rm config/main.cfg; /bin/true
+	rm config/has_users; /bin/true
+	rm config/setup; /bin/true
+
+.PHONY: fail2ban
+fail2ban:
+	cp fail2ban/tcms-jail.tmpl fail2ban/tcms-jail.conf
+	sed -i 's#__LOGDIR__#$(shell pwd)#g' fail2ban/tcms-jail.conf
+	sed -i 's#__DOMAIN__#$(shell bin/tcms-hostname)#g' fail2ban/tcms-jail.conf
+	sudo rm /etc/fail2ban/jail.d/$(shell bin/tcms-hostname).conf; /bin/true
+	sudo rm /etc/fail2ban/filter.d/$(shell bin/tcms-hostname).conf; /bin/true
+	sudo ln -sr fail2ban/tcms-jail.conf   /etc/fail2ban/jail.d/$(shell bin/tcms-hostname).conf
+	sudo ln -sr fail2ban/tcms-filter.conf /etc/fail2ban/filter.d/$(shell bin/tcms-hostname).conf
+	sudo systemctl reload fail2ban
+
+.PHONY: nginx
+nginx:
+	[ -n "$$SERVER_NAME" ] || ( echo "Please set the SERVER_NAME environment variable before running (e.g. test.test)" && /bin/false )
+	sed 's/\%SERVER_NAME\%/$(SERVER_NAME)/g' nginx/tcms.conf.tmpl > nginx/tcms.conf.intermediate
+	sed 's/\%SERVER_SOCK\%/$(shell pwd)/g' nginx/tcms.conf.intermediate > nginx/tcms.conf
+	rm nginx/tcms.conf.intermediate
+	mkdir run
+	chown $(USER):www-data run
+	chmod 0770 run
+	sudo mkdir -p '/var/www/$(SERVER_NAME)'
+	sudo mkdir -p '/var/www/mail.$(SERVER_NAME)'
+	sudo mkdir -p '/etc/letsencrypt/live/$(SERVER_NAME)'
+	[ -e "/etc/nginx/sites-enabled/$$SERVER_NAME.conf" ] && sudo rm "/etc/nginx/sites-enabled/$$SERVER_NAME.conf"; /bin/true
+	sudo ln -sr nginx/tcms.conf '/etc/nginx/sites-enabled/$(SERVER_NAME).conf'
+	# Make a self-signed cert FIRST, because certbot has a chicken/egg problem
+	sudo openssl req -x509 -config etc/openssl.conf -nodes -newkey rsa:4096 -subj '/CN=$(SERVER_NAME)' -addext 'subjectAltName=DNS:www.$(SERVER_NAME),DNS:mail.$(SERVER_NAME)' -keyout '/etc/letsencrypt/live/$(SERVER_NAME)/privkey.pem' -out '/etc/letsencrypt/live/$(SERVER_NAME)/fullchain.pem' -days 365
+	sudo systemctl reload nginx
+	# Now run certbot and get that http dcv. We have to do a "gamer move" so that certbot doesn't complain about live dir existing.
+	sudo rm -rf '/etc/letsencrypt/live/$(SERVER_NAME)'
+	sudo certbot certonly --webroot -w '/var/www/$(SERVER_NAME)/' -d '$(SERVER_NAME)' -d 'www.$(SERVER_NAME)' -w '/var/www/mail.$(SERVER_NAME)' -d 'mail.$(SERVER_NAME)'
+	sudo systemctl reload nginx
+
+.PHONY: mail
+mail: dkim dmarc
+	# Dovecot
+	sudo cp /etc/dovecot/conf.d/10-ssl.conf /etc/dovecot/conf.d/10-ssl.conf.orig
+	sudo sed -i 's/^\(ssl_cert\s*=\).*/\1<\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/fullchain.pem/g' /etc/dovecot/conf.d/10-ssl.conf
+	sudo sed -i 's/^\(ssl_key\s*=\).*/\1\<\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/privkey.pem/g' /etc/dovecot/conf.d/10-ssl.conf
+	# Postfix
+	sudo cp /etc/postfix/main.cf /etc/postfix/main.cf.orig
+	sudo sed -i 's/^\(smtpd_tls_cert_file\s*=\).*/\1\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/fullchain.pem/g' /etc/postfix/main.cf
+	sudo sed -i 's/^\(smtpd_tls_key_file\s*=\).*/\1\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/privkey.pem/g' /etc/postfix/main.cf
+	# XXX we should not do these two.
+	sudo sed -i 's/^\(myhostname\s*=\).*/\1$(SERVER_NAME)/g' /etc/postfix/main.cf
+	sudo echo '$(SERVER_NAME)' > /etc/mailname
+	# Configure postfix to put on its socks and shoes.  This all implicitly relies on good defaults in the opendkim/opendmarc packages.
+	sudo postconf -e milter_default_action=accept
+	sudo postconf -e milter_protocol=2
+	sudo postconf -e smtpd_milters=local:opendkim/opendkim.sock,local:opendmarc/opendmarc.sock
+	sudo postconf -e non_smtpd_milters=\$smtpd_milters
+	sudo service postfix reload
+	# TODO setup various mail aliases and so forth, e.g. postmaster@, soa@, the various lists etc
+
+.PHONY: dkim
+dkim:
+	sudo mkdir -p /etc/opendkim/keys/$(SERVER_NAME)
+	sudo opendkim-genkey --directory /etc/opendkim/keys/$(SERVER_NAME) -s mail -d $(SERVER_NAME)
+	sudo openssl rsa -in /etc/opendkim/keys/$(SERVER_NAME)/mail.private -pubout > /tmp/mail.public
+	sudo mv /tmp/mail.public /etc/opendkim/keys/$(SERVER_NAME)/mail.public
+	sudo chown -R opendkim:opendkim /etc/opendkim
+	sudo mail/mongle_dkim_config $(SERVER_NAME)
+	sudo service opendkim enable
+	sudo service opendkim start
+
+.PHONY: dmarc
+dmarc:
+	sudo mail/mongle_dmarc_config $(SERVER_NAME) mail.$(SERVER_NAME)
+	sudo service opendmarc enable
+	sudo service opendmarc start
+
+.PHONY: dns
+dns:
+	cp dns/tcms.tmpl dns/tcms.conf
+	sed -i 's#__DIR__#$(shell pwd)#g' dns/tcms.conf
+	sed -i 's#__DOMAIN__#$(SERVER_NAME)#g' dns/tcms.conf
+	[[ -e /etc/powerdns/pdns.d/$(SERVER_NAME).conf ]] && sudo rm /etc/powerdns/pdns.d/$(SERVER_NAME).conf
+	sudo cp dns/tcms.conf /etc/powerdns/pdns.d/$(SERVER_NAME).conf
+	sudo mkdir /etc/systemd/resolved.conf.d/; /bin/true
+	sudo cp dns/10-disable-stub-resolver.conf /etc/systemd/resolved.conf.d/
+	sudo chown -R systemd-resolve:systemd-resolve /etc/systemd/resolved.conf.d/
+	sudo chmod 0660 /etc/systemd/resolved.conf.d/10-disable-stub-resolver.conf
+	sudo systemctl restart systemd-resolved
+	# Build the zone database and initialize the zone for our domain
+	rm dns/zones.db; /bin/true
+	sqlite3 dns/zones.db < /usr/share/pdns-backend-sqlite3/schema/schema.sqlite3.sql
+	bin/build_zone > dns/default.zone
+	zone2sql --gsqlite --zone=dns/default.zone --zone-name=$(SERVER_NAME) > dns/default.zone.sql
+	sqlite3 dns/zones.db < dns/default.zone.sql
+	# Bind mount our dns/ folder so that pdns can see it in chroot
+	sudo mkdir /var/spool/powerdns/$(SERVER_NAME); /bin/true
+	sudo chown pdns:pdns /var/spool/powerdns/$(SERVER_NAME); /bin/true
+	sudo cp /etc/fstab /tmp/fstab.new
+	sudo chown $(USER) /tmp/fstab.new
+	echo "$(shell pwd)/dns /var/spool/powerdns/$(SERVER_NAME) none defaults,bind 0 0" >> /tmp/fstab.new
+	sort < /tmp/fstab.new | uniq | grep -o '^[^#]*' > /tmp/fstab.new
+	sudo chown root:root /tmp/fstab.new
+	sudo mv /etc/fstab /etc/fstab.bak
+	sudo mv /tmp/fstab.new /etc/fstab
+	sudo mount /var/spool/powerdns/$(SERVER_NAME)
+	# Don't need no bind
+	[[ -e /etc/powerdns/pdns.d/bind.conf ]] && sudo rm /etc/powerdns/pdns.d/bind.conf
+	# Fix broken service configuration
+	sudo bin/configure_pdns
+	sudo cp dns/10-powerdns.conf /etc/rsyslog.d/10-powerdns.conf 
+	sudo systemctl daemon-reload
+	sudo service rsyslog restart
+	sudo service pdns enable
+	sudo service pdns start
+
+.PHONY: githook
+githook:
+	cp git-hooks/pre-commit .git/hooks
+
+.PHONY: all
+all: prereq-debian install fail2ban nginx mail dns githook

Makefile

@@ -1,113 +0,0 @@
-SHELL := /bin/bash
-
-.PHONY: depend
-depend:
-	[ -f "/etc/debian_version" ] && make prereq-debs; /bin/true;
-	make prereq-perl prereq-frontend
-
-.PHONY: install
-install:
-	test -d www/themes || mkdir -p www/themes
-	test -d data/files || mkdir -p data/files
-	test -d www/assets || mkdir -p www/assets
-	test -d www/statics || mkdir -p www/statics
-	test -d totp/ || mkdir -p totp
-	test -d ~/.tcms || mkdir ~/.tcms
-	test -d logs/db/ && mkdir -p logs/db/; /bin/true
-	$(RM) pod2htmd.tmp;
-
-.PHONY: install-service
-install-service:
-	mkdir -p ~/.config/systemd/user
-	cp service-files/systemd.unit ~/.config/systemd/user/tCMS.service
-	sed -ie 's#__REPLACEME__#$(shell pwd)#g' ~/.config/systemd/user/tCMS.service
-	sed -ie 's#__PORT__#$(PORT)#g' ~/.config/systemd/user/tCMS.service
-	systemctl --user daemon-reload
-	systemctl --user enable tCMS
-	systemctl --user start tCMS
-	loginctl enable-linger $(USER)
-
-.PHONY: prereq-debian
-prereq-debian: prereq-debs prereq-perl prereq-frontend prereq-node
-
-.PHONY: prereq-debs
-prereq-debs:
-	sudo apt-get update
-	sudo apt-get install -y sqlite3 nodejs npm libsqlite3-dev libdbd-sqlite3-perl cpanminus starman libxml2 curl         \
-		uwsgi uwsgi-plugin-psgi fail2ban nginx certbot postfix dovecot-imapd dovecot-pop3d postgrey spamassassin amavis clamav\
-	    libtext-xslate-perl libplack-perl libconfig-tiny-perl libdatetime-format-http-perl libjson-maybexs-perl          \
-	    libuuid-tiny-perl libcapture-tiny-perl libconfig-simple-perl libdbi-perl libfile-slurper-perl libfile-touch-perl \
-	    libfile-copy-recursive-perl libxml-rss-perl libmodule-install-perl libio-string-perl uuid-dev                    \
-	    libmoose-perl libmoosex-types-datetime-perl libxml-libxml-perl liblist-moreutils-perl libclone-perl libpath-tiny-perl
-
-.PHONY: prereq-perl
-prereq-perl:
-	sudo cpanm -n --installdeps .
-
-.PHONY: prereq-node
-prereq-node:
-	npm i
-
-.PHONY: prereq-frontend
-prereq-frontend:
-	mkdir -p www/scripts; pushd www/scripts && curl -L --remote-name-all                                 \
-		"https://raw.githubusercontent.com/chalda-pnuzig/emojis.json/master/dist/list.min.json"     \
-		"https://raw.githubusercontent.com/highlightjs/cdn-release/main/build/highlight.min.js"; popd
-	mkdir -p www/styles; cd www/styles && curl -L --remote-name-all \
-		"https://raw.githubusercontent.com/highlightjs/cdn-release/main/build/styles/obsidian.min.css"
-
-.PHONY: reset
-reset: reset-remove install
-
-.PHONY: reset-remove
-reset-remove:
-	rm -rf data; /bin/true
-	rm -rf www/themes; /bin/true
-	rm -rf www/assets; /bin/true
-	rm config/auth.db; /bin/true
-	rm config/main.cfg; /bin/true
-	rm config/has_users; /bin/true
-	rm config/setup; /bin/true
-
-.PHONY: fail2ban
-fail2ban:
-	sudo ln -sr fail2ban/tcms-jail.conf   /etc/fail2ban/jail.d/tcms.conf
-	sudo ln -sr fail2ban/tcms-filter.conf /etc/fail2ban/filter.d/tcms.conf
-	sudo systemctl reload fail2ban
-
-.PHONY: nginx
-nginx:
-	[ -n "$$SERVER_NAME" ] || ( echo "Please set the SERVER_NAME environment variable before running (e.g. test.test)" && /bin/false )
-	[ -n "$$SERVER_PORT" ] || ( echo "Please set the SERVER_PORT environment variable before running (e.g. 5000)" && /bin/false )
-	sed 's/\%SERVER_NAME\%/$(SERVER_NAME)/g' nginx/tcms.conf.tmpl > nginx/tcms.conf.intermediate
-	sed 's/\%SERVER_PORT\%/$(SERVER_PORT)/g' nginx/tcms.conf.intermediate > nginx/tcms.conf
-	rm nginx/tcms.conf.intermediate
-	sudo mkdir -p '/var/www/$(SERVER_NAME)'
-	sudo mkdir -p '/var/www/mail.$(SERVER_NAME)'
-	sudo mkdir -p '/etc/letsencrypt/live/$(SERVER_NAME)'
-	[ -e "/etc/nginx/sites-enabled/$$SERVER_NAME.conf" ] && sudo rm "/etc/nginx/sites-enabled/$$SERVER_NAME.conf"
-	sudo ln -sr nginx/tcms.conf '/etc/nginx/sites-enabled/$(SERVER_NAME).conf'
-	# Make a self-signed cert FIRST, because certbot has a chicken/egg problem
-	sudo openssl req -x509 -config etc/openssl.conf -nodes -newkey rsa:4096 -subj '/CN=$(SERVER_NAME)' -addext 'subjectAltName=DNS:www.$(SERVER_NAME),DNS:mail.$(SERVER_NAME)' -keyout '/etc/letsencrypt/live/$(SERVER_NAME)/privkey.pem' -out '/etc/letsencrypt/live/$(SERVER_NAME)/fullchain.pem' -days 365
-	sudo systemctl reload nginx
-	# Now run certbot and get that http dcv. We have to do a "gamer move" so that certbot doesn't complain about live dir existing.
-	sudo rm -rf '/etc/letsencrypt/live/$(SERVER_NAME)'
-	sudo certbot certonly --webroot -w '/var/www/$(SERVER_NAME)/' -d '$(SERVER_NAME)' -d 'www.$(SERVER_NAME)' -w '/var/www/mail.$(SERVER_NAME)' -d 'mail.$(SERVER_NAME)'
-	sudo systemctl reload nginx
-
-.PHONY: mail
-mail: nginx
-	# Dovecot
-	sudo cp /etc/dovecot/conf.d/10-ssl.conf /etc/dovecot/conf.d/10-ssl.conf.orig
-	sudo sed -i 's/^\(ssl_cert\s*=\).*/\1<\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/fullchain.pem/g' /etc/dovecot/conf.d/10-ssl.conf
-	sudo sed -i 's/^\(ssl_key\s*=\).*/\1\<\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/privkey.pem/g' /etc/dovecot/conf.d/10-ssl.conf
-	# Postfix
-	sudo cp /etc/postfix/main.cf /etc/postfix/main.cf.orig
-	sudo sed -i 's/^\(smtpd_tls_cert_file\s*=\).*/\1\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/fullchain.pem/g' /etc/postfix/main.cf
-	sudo sed -i 's/^\(smtpd_tls_key_file\s*=\).*/\1\/etc\/letsencrypt\/live\/$(SERVER_NAME)\/privkey.pem/g' /etc/postfix/main.cf
-	sudo sed -i 's/^\(myhostname\s*=\).*/\1$(SERVER_NAME)/g' /etc/postfix/main.cf
-	sudo echo '$(SERVER_NAME)' > /etc/mailname
-	# TODO everything else
-
-.PHONY: all
-all: prereq-debian install fail2ban mail

Makefile.PL

@@ -64,6 +64,14 @@ WriteMakefile(
     'HTTP::Tiny::UNIX'          => '0',
     'Email::MIME'               => '0',
     'Email::Sender::Simple'     => '0',
+    'POSIX::strptime'           => '0',
+    'Log::Dispatch::DBI'        => '0',
+    'Email::MIME'               => '0',
+    'Email::Sender::Simple'     => '0',
+    'DNS::Unbound'              => '0',
+    'Net::IP'                   => '0',
+    'File::LibMagic'            => '0',
+    'Linux::Perl::inotify'      => '0',
   },
   test => {TESTS => 't/*.t'}
 );

Readme.md

@@ -1,22 +1,28 @@
 tCMS
 =====
 
-A flexible perl CMS which supports multiple data models and content types
+A flexible perl CMS which supports multiple data models and content types.
+Should be readily portable/hostable between any other system that runs tCMS due to being largely self-contained.
+
+tCMS is built fully around ubuntu hosts at the moment.
 
 Deployment is currently:
-* make depend
-* make install
+* make -f Installer.mk depend
+* make -f Installer.mk install
 
 Then:
-* Set up proxy rule in your webserver
 * open tmux or screen
-* `starman -p $PORT www/server.psgi`
+* `sudo ./tcms`
 OR (if you want tCMS as a systemd service for the current user):
-* PORT=$PORT make install-service
+* `make install-service`
+
+This sets up nginx, reverse proxy and SSL certs for you.
+You must set up the user which runs tCMS to have the primary group www-data if you want to be able to run without sudo or run as a usermode service.
+It is strongly suggested that you chmod everything but the run/ directory to be 0700, particularly in a shared environment.
 
-$PORT being whatever port you want it to sit on.
+It also sets up the mailserver and DNS for you.
 
-TODO: Make the makefile not rewrite itself when running make! Reset for now after run.
+You should add the pdns group to the user you use to run tCMS, so that the zone management features will work.
 
 A Dockerfile and deployment scripts are provided for your convenience in building/running containers based on this:
 ```
@@ -27,9 +33,12 @@ A Dockerfile and deployment scripts are provided for your convenience in buildin
 # Extract configuration & local data, then spin down the server
 ./docker-exfil.sh
 ```
+There is also podman container code; see images/README.md
+
 The user guide is self-hosted; After you first login, hit the 'Manual' section in the backend.
 
 Rate-Limiting is expected to be handled at the level of the webserver proxying requests to this application.
+See ufw/setup-rules as an example of the easy way to setup rules/limiting for all the services you need to run tCMS.
 
 Migration of tCMS1 sites
 =========================
@@ -39,7 +48,7 @@ See migrate.pl, and modify the $docroot variable appropriately
 Content Types
 =============
 Content templates are modular.
-Add in a template to /templates/forms which describe the content *and* how to edit it.
+Add in a template to www/templates/html/components/forms which describe the content *and* how to edit it.
 Our post data storage being JSON allows us the flexibility to have any kind of meta associated with posts, so go hog wild.
 
 Currently supported:
@@ -48,9 +57,10 @@ Currently supported:
 * Files (Video/Audio/Images/Other)
 * About Pages
 * Post Series
+* Presentations
 
 Planned development:
-* Presentations
+* LaTeX
 * Test Plans / Issues (crossover with App::Prove::Elasticsearch)
 
 Embedding Posts within other Posts
@@ -86,8 +96,8 @@ Supported PSGI servers
 
 Starman and uWSGI
 
-In production, I would expect you to run under uWSGI, and the `tcms` command in the TLD runs this.
-Otherwise, you can run `www/server.psgi` to start starman normally.
+In production, I would expect you to run under uWSGI, and the `tcms-uwsgi` command in the TLD runs this.
+Otherwise, you can run `tcms` to start starman normally.
 
 Ideas to come:
 =============

bin/build_zone

@@ -0,0 +1,157 @@
+#!/usr/bin/env perl
+
+=head1 build_zone
+
+Build the basic zone for a tCMS site and import it into powerdns.
+Otherwise, make it a post so you can edit it in the config backend.
+
+In general this should not be called outside of Installer.mk.
+
+=head2 OPTIONS
+
+=head3 subdomain
+
+Specify a subdomain, such as 'foo' to add to the domain.
+
+May be passed multiple times.
+
+=head3 gsv
+
+Google site verification string goes into TXT record
+
+=head3 cname
+
+Specify a cname, such as 'bar' to add to the domain.
+
+By default, the cnames 'www', 'mail' and 'chat' are set up, as these are essential tCMS services setup by the makefile before this.
+
+May be passed multiple times.
+
+=cut
+
+use strict;
+use warnings;
+
+no warnings qw{experimental};
+use feature qw{signatures state};
+
+use FindBin::libs;
+use Trog::Config();
+use Trog::Zone();
+use Trog::Auth;
+
+use DNS::Unbound;
+use Net::DNS::Packet;
+
+use Text::Xslate;
+use Net::IP;
+
+use Getopt::Long qw{GetOptionsFromArray};
+
+$ENV{NOHUP} = 1;
+
+exit main(@ARGV) unless caller;
+
+sub main(@args) {
+
+    my %options;
+    GetOptionsFromArray(\@args,
+        'subdomain=s@' => \$options{subdomains},
+        'gsv=s'        => \$options{gsv},
+        'cname=s@'     => \$options{cnames},
+    );
+
+    # Paranoia, some versions of getopt don't do this
+    $options{cnames}     //= [];
+    $options{subdomains} //=[];
+
+    my $domain = Trog::Config->get()->param('general.hostname');
+    die "Hostname not set in tCMS configuration.  Please set this first." unless $domain;
+
+    my $user = Trog::Auth::primary_user;
+    die "Primary tCMS user not yet set up" unless $user;
+
+    # Get a flesh start
+    Trog::Zone::delzone($domain);
+
+    my ($ip)  = domain2ips($domain, 'A');
+    my ($ip6) = domain2ips($domain, 'AAAA');
+
+    my $data = {
+        ip  => $ip,
+        ip6 => $ip6,
+        ip_reversed  => Net::IP->new($ip)->reverse_ip(),
+        ip6_reversed => Net::IP->new($ip6)->reverse_ip(),
+        title => $domain,
+        nameservers => ["ns1.$domain"],
+        subdomains  => [map { { name => $_, ip => domain2ips("$_.$domain", "A"), "ip6" => domain2ips("$_.$domain", "AAAA"), nameservers => ["ns1.$_.$domain"] } } @{$options{subdomains}}],
+        cnames      => [(qw{www mail chat},@{$options{cnames}})],
+        gsv_string  => $options{gsv} // '',
+        version    => 0,
+        dkim_pkey => extract_pkey($domain),
+        acme_challenge => get_dns_dcv_string( $domain ),
+        visibility => 'private',
+        acls       => [qw{admin}],
+        aliases    => [],
+        tags       => ['zone'],
+        form       => 'dns.tx',
+        callback   => "Trog::Routes::TXT::zone",
+        id         => undef,
+        created    => undef,
+        local_href => "/text/zone/$domain",
+        href       => "/text/zone/$domain",
+        user       => $user,
+    };
+
+    my $zone = Trog::Zone::addzone($data);
+    print $data->{data};
+
+    return 0;
+}
+
+sub extract_pkey ( $domain ) {
+    open(my $fh, '<', "/etc/opendkim/keys/$domain/mail.public");
+    my @lines = map { chomp $_; $_ } readline $fh;
+    close $fh;
+    shift @lines;
+    pop @lines;
+    return join('', @lines);
+}
+
+sub get_dns_dcv_string( $domain ) {
+    return "TODO";
+}
+
+sub domain2ips( $domain, $type ) {
+    # XXX would be great to use state here, but felipe
+    my $resolver = DNS::Unbound->new();
+
+    my $p = $resolver->resolve( $domain, $type )->answer_packet();
+    my @rrs = Net::DNS::Packet->new( \$p )->answer;
+
+    my @addr = map { $_->address } @rrs;
+    @addr=(get_local_ip($type)) unless @addr;
+    return @addr;
+}
+
+my $addrout='';
+sub get_local_ip( $type ) {
+    $addrout //=qx{ip addr};
+    return $type eq 'A' ? _ipv4() : _ipv6();
+}
+
+sub _ipv4 {
+    state $ip;
+    return $ip if $ip;
+    ($ip) = $addrout =~ m{inet\s+([\d|\.|/]+)\s+scope\s+global}gmx;
+    return $ip;
+}
+
+sub _ipv6 {
+    state $ip6;
+    return $ip6 if $ip6;
+    ($ip6) = $addrout =~ m{inet6\s+([a-f|\d|:|/]+)\s+scope\s+global\s+dynamic\s+mngtmpaddr}gmx;
+    # We have to strip the CIDR off of it, or it breaks Net::IP's brain.
+    $ip6 =~ s|/\d+$||;
+    return $ip6;
+}

bin/consolidate_logs.pl

@@ -1,48 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use FindBin::libs;
-use Trog::SQLite;
-use POSIX ":sys_wait_h";
-use Time::HiRes qw{usleep};
-
-# Every recorded request is fully finished, so we can treat them as such.
-my $cons_dbh = Trog::SQLite::dbh( 'schema/log.schema', "logs/consolidated.db" );
-
-opendir(my $dh, "logs/db");
-my @pids;
-foreach my $db (readdir($dh)) {
-    next unless $db =~ m/\.db$/;
-    die "AAAGH" unless -f "logs/db/$db";
-    my $dbh = Trog::SQLite::dbh( 'schema/log.schema', "logs/db/$db" );
-    my $pid = fork();
-    if (!$pid) {
-        do_row_migration($dbh);
-        exit 0;
-    }
-    push(@pids, $pid);
-}
-while (@pids) {
-    my $pid = shift(@pids);
-    my $status = waitpid($pid, WNOHANG);
-    push(@pids, $pid) if $status == 0;
-    usleep(100);
-}
-
-sub do_row_migration {
-    my ($dbh) = @_;
-    my $query = "select * from all_requests";
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    while (my @rows = @{ $sth->fetchall_arrayref({}, 100000) || [] }) {
-        my @bind = sort keys(%{$rows[0]});
-        my @rows_bulk = map { my $subj = $_; map { $subj->{$_} } @bind } @rows;
-        Trog::SQLite::bulk_insert($cons_dbh, 'all_requests', \@bind, 'IGNORE', @rows_bulk);
-
-        # Now that we've migrated the rows from the per-fork DBs, murder these rows
-        my $binder = join(',', (map { '?' } @rows));
-        $dbh->do("DELETE FROM requests WHERE uuid IN ($binder)", undef, map { $_->{uuid} } @rows);
-    }
-}

bin/tcms-hostname

@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use FindBin::libs;
+
+use Trog::Config();
+
+my $hostname = $ARGV[0];
+
+my $conf = Trog::Config->get();
+if ($hostname) {
+    $conf->param('general.hostname', $hostname);
+    $conf->save();
+}
+
+my $domain = $conf->param('general.hostname');
+die "Hostname not set in tCMS configuration.  Please set this first by passing the hostname to bin/tcms-hostname." unless $domain;
+
+print "$domain\n";

bin/tcms-useradd

@@ -13,6 +13,7 @@ use List::Util qw{first};
 use Trog::Auth;
 use Trog::Data;
 use Trog::Config;
+use Trog::Log;
 
 # Don't murder our terminal when done
 $ENV{NOHUP} = 1;
@@ -61,6 +62,8 @@ Display this output.
 =cut
 
 sub main {
+    Trog::Log::log_init();
+
     my %options;
     Getopt::Long::GetOptionsFromArray(
         \@_,
@@ -97,7 +100,7 @@ sub main {
     # We don't want the password in plain text
     delete $merged{password};
 
-    # The ACLs a user posesses is not necessarily what ACLs you need to view a user's profile.
+    # The ACLs a user posesses is not necessarily what ACLs you need to view or edit a user's profile.
     delete $merged{acl};
 
     $data->add( \%merged );

config/tcms.ini

@@ -3,10 +3,11 @@
 
 master = 1
 processes = 20
-http-socket = :5000
 plugin = psgi
-socket = tcms.sock
+socket = run/tcms.sock
 thunder-lock = 1
+safe-pidfile=run/tcms.pid
+daemonize = 1
 
 # Respawn workers after X requests, just in case there are subtle memory leaks
 max-requests = 1024

dns/10-disable-stub-resolver.conf

@@ -0,0 +1,4 @@
+[Resolve]
+DNS=8.8.8.8
+FallbackDNS=8.8.4.4
+DNSStubListener=no

dns/10-powerdns.conf

@@ -0,0 +1 @@
+local1.* /var/log/pdns.log

dns/configure_pdns

@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use File::Copy;
+use Config::Simple;
+
+# Fix broken out of the box systemd unit for pdns
+my $service_file = "/usr/lib/systemd/system/pdns.service";
+die "Can't find service file $service_file" unless -f $service_file;
+
+my $cfg = Config::Simple->new($service_file);
+
+#$cfg->param("Service.WorkingDirectory", "/var/spool/powerdns");
+my $invocation = "/usr/sbin/pdns_server --guardian=no --daemon=no --logging-facility=1 --log-timestamp=yes --write-pid=no --chroot";
+$cfg->param("Service.ExecStart", $invocation);
+
+File::Copy::copy($service_file, "$service_file.bak");
+$cfg->save();

dns/tcms.tmpl

@@ -0,0 +1,3 @@
+# tCMS powerdns configuration for __DOMAIN__
+launch=gsqlite3:__DOMAIN__
+gsqlite3-__DOMAIN__-database=__DOMAIN__/zones.db

fail2ban/tcms-jail.conf → fail2ban/tcms-jail.tmpl

@@ -1,8 +1,8 @@
-[tcms]
+[__DOMAIN__]
 enabled = true
 port = http,https
-filter = tcms
-logpath = /var/log/www/tcms.log
+filter = __DOMAIN__
+logpath = __LOGDIR__/logs/tcms.log
 maxretry = 5
 findtime = 60
 bantime  = 600

git-hooks/pre-commit

@@ -0,0 +1,14 @@
+#!/bin/sh
+
+to_tidy=$(git diff --cached --name-only  | egrep ".p[m|l]$")
+
+# Redirect output to stderr.
+exec 1>&2
+
+if [ $to_tidy  ]
+then
+    echo "Auto-tidying perl changes..."
+    perltidy -b $to_tidy
+    git add $to_tidy
+    echo "Done."
+fi

lib/TCMS.pm

@@ -6,23 +6,22 @@ use warnings;
 no warnings 'experimental';
 use feature qw{signatures state};
 
-use Clone qw{clone};
+use Clone        qw{clone};
 use Date::Format qw{strftime};
 
 use Sys::Hostname();
 use HTTP::Body   ();
 use URL::Encode  ();
 use Text::Xslate ();
-use Plack::MIME  ();
-use Mojo::File   ();
 use DateTime::Format::HTTP();
 use CGI::Cookie ();
 use File::Basename();
 use IO::Compress::Gzip();
-use Time::HiRes qw{gettimeofday tv_interval};
+use Time::HiRes      qw{gettimeofday tv_interval};
 use HTTP::Parser::XS qw{HEADERS_AS_HASHREF};
 use List::Util;
 use URI();
+use Ref::Util qw{is_coderef is_hashref is_arrayref};
 
 #Grab our custom routes
 use FindBin::libs;
@@ -30,6 +29,8 @@ use Trog::Routes::HTML;
 use Trog::Routes::JSON;
 
 use Trog::Log qw{:all};
+use Trog::Log::DBI;
+
 use Trog::Auth;
 use Trog::Utils;
 use Trog::Config;
@@ -67,15 +68,19 @@ If a path passed is not a defined route (or regex route), but exists as a file u
 
 sub _app {
 
+    # Make sure all writes are with the proper permissions, none need know of our love
+    umask 0077;
+
+    INFO("TCMS starting up on PID $MASTER_PID, Worker PID $$");
     # Start the server timing clock
     my $start = [gettimeofday];
 
     # Build the routing table
-    state ($conf, $data, %aliases);
-    
-    $conf  //= Trog::Config::get();
-    $data  //= Trog::Data->new($conf);
-    my %routes = %{_routes($data)};
+    state( $conf, $data, %aliases );
+
+    $conf //= Trog::Config::get();
+    $data //= Trog::Data->new($conf);
+    my %routes = %{ _routes($data) };
     %aliases = $data->aliases() unless %aliases;
 
     # XXX this is built progressively across the forks, leading to inconsistent behavior.
@@ -107,6 +112,14 @@ sub _app {
     # sigdie can now "do the right thing"
     $cur_query = { route => $path, fullpath => $path, method => $method };
 
+    # Set the IP of the request so we can fail2ban
+    $Trog::Log::ip = $env->{HTTP_X_FORWARDED_FOR} || $env->{REMOTE_ADDR};
+
+    # Set the referer & ua to go into DB logs, but not logs in general.
+    # The referer/ua largely has no importance beyond being a proto bug report for log messages.
+    $Trog::Log::DBI::referer = $env->{HTTP_REFERER};
+    $Trog::Log::DBI::ua      = $env->{HTTP_UA};
+
     # Check eTags.  If we don't know about it, just assume it's good and lazily fill the cache
     # XXX yes, this allows cache poisoning...but only for logged in users!
     if ( $env->{HTTP_IF_NONE_MATCH} ) {
@@ -121,10 +134,18 @@ sub _app {
     #TODO: Actually do something with the acceptable output formats in the renderer
     my $accept = $env->{HTTP_ACCEPT};
 
-    # These two parameters are entirely academic, as no integration with any kind of analytics is implemented.
+    # Figure out if we want compression or not
+    my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
+    $alist =~ s/\s//g;
+    my @accept_encodings;
+    @accept_encodings = split( /,/, $alist );
+    my $deflate = grep { 'gzip' eq $_ } @accept_encodings;
+
+    # NOTE These two parameters are entirely academic, as we don't use ad tracking cookies, but the UTM parameters.
+    # UTMs are actually fully sufficient to get you what you want -- e.g. keywords, audience groups, a/b testing, etc.
+    # and you need to put up cookie consent banners if you bother using tracking cookies, which are horrific UX.
     #my $no_track = $env->{HTTP_DNT};
     #my $no_sell_info = $env->{HTTP_SEC_GPC};
-    #my $referrer     = $env->{HTTP_REFERER};
 
     # We generally prefer this to be handled at the reverse proxy level.
     #my $prefer_ssl = $env->{HTTP_UPGRADE_INSECURE_REQUESTS};
@@ -154,9 +175,6 @@ sub _app {
         @$query{ keys( %{ $body->upload } ) } = values( %{ $body->upload } );
     }
 
-    # Grab the list of ACLs we want to add to a post, if any.
-    $query->{acls} = [ $query->{acls} ] if ( $query->{acls} && ref $query->{acls} ne 'ARRAY' );
-
     # It's mod_rewrite!
     $path = '/index' if $path eq '/';
 
@@ -166,63 +184,44 @@ sub _app {
     # Translate alias paths into their actual path
     $path = $aliases{$path} if exists $aliases{$path};
 
-    # Figure out if we want compression or not
-    my $alist = $env->{HTTP_ACCEPT_ENCODING} || '';
-    $alist =~ s/\s//g;
-    my @accept_encodings;
-    @accept_encodings = split( /,/, $alist );
-    my $deflate = grep { 'gzip' eq $_ } @accept_encodings;
-
     # Collapse multiple slashes in the path
     $path =~ s/[\/]+/\//g;
 
-    # Let's open up our default route before we bother to see if users even exist
-    return $routes{default}{callback}->($query) unless -f "config/setup";
-
-    my $cookies = {};
-    if ( $env->{HTTP_COOKIE} ) {
-        $cookies = CGI::Cookie->parse( $env->{HTTP_COOKIE} );
-    }
-
-    # Set the IP of the request so we can fail2ban
-    $Trog::Log::ip = $env->{HTTP_X_FORWARDED_FOR} || $env->{REMOTE_ADDR};
+    #Handle regex/capture routes
+    if ( !exists $routes{$path} ) {
+        my @captures;
 
-    my $active_user = '';
-    $Trog::Log::user = 'nobody';
-    if ( exists $cookies->{tcmslogin} ) {
-        $active_user     = Trog::Auth::session2user( $cookies->{tcmslogin}->value );
-        $Trog::Log::user = $active_user if $active_user;
+        # XXX maybe this should all just go into $query?
+        # TODO can optimize by having separate hashes for capture/non-capture routes
+        foreach my $pattern ( keys(%routes) ) {
+            @captures = $path =~ m/^$pattern$/;
+            if (@captures) {
+                $path = $pattern;
+                foreach my $field ( @{ $routes{$path}{captures} } ) {
+                    $routes{$path}{data} //= {};
+                    $routes{$path}{data}{$field} = shift @captures;
+                }
+                last;
+            }
+        }
     }
-    $query->{user_acls} = [];
-    $query->{user_acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
 
-    # Filter out passed ACLs which are naughty
-    my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
-    @{ $query->{acls} } = grep { $_ ne 'admin' } @{ $query->{acls} } unless $is_admin;
+    # Set the 'data' in the query that the route specifically overrides, which we are also using for the catpured data
+    # This also means you have to validate both of them via parameters if you set that up.
+    @{$query}{ keys( %{ $routes{$path}{'data'} } ) } = values( %{ $routes{$path}{'data'} } ) if ref $routes{$path}{'data'} eq 'HASH' && %{ $routes{$path}{'data'} };
 
-    # Ensure any short-circuit routes can log the request
-    $query->{method} = $method;
-    $query->{route}  = $path;
+    # Ensure any short-circuit routes can log the request, and return the server-timing headers properly
+    $query->{method}   = $method;
+    $query->{route}    = $path;
+    $query->{fullpath} = $fullpath;
+    $query->{start}    = $start;
 
-    # Disallow any paths that are naughty ( starman auto-removes .. up-traversal)
-    if ( index( $path, '/templates' ) == 0 || index( $path, '/statics' ) == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
-        return _forbidden($query);
-    }
+    # Handle HTTP range/streaming requests
+    my $range = $env->{HTTP_RANGE} || "bytes=0-" if $env->{HTTP_RANGE} || $env->{HTTP_IF_RANGE};
 
     my $streaming = $env->{'psgi.streaming'};
     $query->{streaming} = $streaming;
 
-    # If we have a static render, just use it instead (These will ALWAYS be correct, data saves invalidate this)
-    # TODO: make this key on admin INSTEAD of active user when we add non-admin users.
-    $query->{start} = $start;
-    if ( !$active_user && !$has_query ) {
-        return _static( $fullpath, "$path.z", $start, $streaming ) if -f "www/statics/$path.z" && $deflate;
-        return _static( $fullpath, $path,     $start, $streaming ) if -f "www/statics/$path";
-    }
-
-    # Handle HTTP range/streaming requests
-    my $range = $env->{HTTP_RANGE} || "bytes=0-" if $env->{HTTP_RANGE} || $env->{HTTP_IF_RANGE};
-
     my @ranges;
     if ($range) {
         $range =~ s/bytes=//g;
@@ -237,36 +236,84 @@ sub _app {
         );
     }
 
-    return Trog::FileHandler::serve( $fullpath, "www/$path",  $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
-    return Trog::FileHandler::serve( $fullpath, "totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "totp/$path" && $active_user;
+    # If it's a file, just serve it
+    return Trog::FileHandler::serve( $fullpath, "www/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "www/$path";
 
-    #Handle regex/capture routes
-    if ( !exists $routes{$path} ) {
-        my @captures;
+    # Figure out if we have a logged in user, so we can serve them user-specific files
+    my $cookies = {};
+    if ( $env->{HTTP_COOKIE} ) {
+        $cookies = CGI::Cookie->parse( $env->{HTTP_COOKIE} );
+    }
 
-        # TODO can optimize by having separate hashes for capture/non-capture routes
-        foreach my $pattern ( keys(%routes) ) {
-            @captures = $path =~ m/^$pattern$/;
-            if (@captures) {
-                $path = $pattern;
-                foreach my $field ( @{ $routes{$path}{captures} } ) {
-                    $routes{$path}{data} //= {};
-                    $routes{$path}{data}{$field} = shift @captures;
-                }
-                last;
-            }
-        }
+    my $active_user = '';
+    $Trog::Log::user = 'nobody';
+    if ( exists $cookies->{tcmslogin} ) {
+        $active_user     = Trog::Auth::session2user( $cookies->{tcmslogin}->value );
+        $Trog::Log::user = $active_user if $active_user;
     }
 
-    $query->{fullpath} = $fullpath;
-    $query->{deflate}  = $deflate;
-    $query->{user}     = $active_user;
+    return Trog::FileHandler::serve( $fullpath, "totp/$path", $start, $streaming, \@ranges, $last_fetch, $deflate ) if -f "totp/$path" && $active_user;
 
+    # Now that we have firmed up the actual routing, let's validate.
     return _forbidden($query) if exists $routes{$path}{auth} && !$active_user;
     return _notfound($query) unless exists $routes{$path} && ref $routes{$path} eq 'HASH' && keys( %{ $routes{$path} } );
     return _badrequest($query) unless grep { $env->{REQUEST_METHOD} eq $_ } ( $routes{$path}{method} || '', 'HEAD' );
 
-    @{$query}{ keys( %{ $routes{$path}{'data'} } ) } = values( %{ $routes{$path}{'data'} } ) if ref $routes{$path}{'data'} eq 'HASH' && %{ $routes{$path}{'data'} };
+    # Disallow any paths that are naughty ( starman auto-removes .. up-traversal)
+    if ( index( $path, '/templates' ) == 0 || index( $path, '/statics' ) == 0 || $path =~ m/.*(\.psgi|\.pm)$/i ) {
+        return _forbidden($query);
+    }
+
+    # Set the urchin parameters if necessary.
+    %$Trog::Log::DBI::urchin = map { $_ => delete $query->{$_} } qw{utm_source utm_medium utm_campaign utm_term utm_content};
+
+    # Now that we've parsed the query and know where we want to go, we should murder everything the route does not explicitly want, and validate what it does
+    my $parameters = $routes{$path}{parameters};
+    if ($parameters) {
+        die "invalid route definition for $path: bad parameters" unless is_hashref($parameters);
+        my @known_params = keys(%$parameters);
+        for my $param (@known_params) {
+            die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless is_coderef( $parameters->{$param} );
+
+            # A missing parameter is not necessarily a problem.
+            next unless $query->{$param};
+
+            # But if we have it, and it's bad, nack it, so that scanners get fail2banned.
+            DEBUG("Rejected $fullpath for bad query param $param");
+            return _badrequest($query) unless $parameters->{$param}->( $query->{$param} );
+        }
+
+        # Smack down passing of unnecessary fields
+        foreach my $field ( keys(%$query) ) {
+            next if List::Util::any { $field eq $_ } @known_params;
+            next if List::Util::any { $field eq $_ } qw{start route streaming method fullpath};
+            DEBUG("Rejected $fullpath for query param $field");
+            return _badrequest($query);
+        }
+    }
+
+    # Let's open up our default route before we bother thinking about routing any harder
+    return $routes{default}{callback}->($query) unless -f "config/setup";
+
+    $query->{user_acls} = [];
+    $query->{user_acls} = Trog::Auth::acls4user($active_user) // [] if $active_user;
+
+    # Grab the list of ACLs we want to add to a post, if any.
+    $query->{acls} = [ $query->{acls} ] if ( $query->{acls} && ref $query->{acls} ne 'ARRAY' );
+
+    # Filter out passed ACLs which are naughty
+    my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
+    @{ $query->{acls} } = grep { $_ ne 'admin' } @{ $query->{acls} } unless $is_admin;
+
+    # If we have a static render, just use it instead (These will ALWAYS be correct, data saves invalidate this)
+    # TODO: make this key on admin INSTEAD of active user when we add non-admin users.
+    if ( !$active_user && !$has_query ) {
+        return _static( $fullpath, "$path.z", $start, $streaming ) if -f "www/statics/$path.z" && $deflate;
+        return _static( $fullpath, $path,     $start, $streaming ) if -f "www/statics/$path";
+    }
+
+    $query->{deflate} = $deflate;
+    $query->{user}    = $active_user;
 
     #Set various things we don't want overridden
     $query->{body}         = '';
@@ -285,6 +332,8 @@ sub _app {
     # Redirecting somewhere naughty not allow
     $query->{to} = URI->new( $query->{to} // '' )->path() || $query->{to} if $query->{to};
 
+    DEBUG("DISPATCH $path to $routes{$path}{callback}");
+
     #XXX there is a trick to now use strict refs, but I don't remember it right at the moment
     {
         no strict 'refs';
@@ -294,24 +343,24 @@ sub _app {
         my $pport = defined $query->{port} ? ":$query->{port}" : "";
         INFO("$env->{REQUEST_METHOD} $output->[0] $fullpath");
 
-        # Append server-timing headers
+        # Append server-timing headers if they aren't present
         my $tot = tv_interval($start) * 1000;
-        push( @{ $output->[1] }, 'Server-Timing' => "app;dur=$tot" );
+        push( @{ $output->[1] }, 'Server-Timing' => "app;dur=$tot" ) unless List::Util::any { $_ eq 'Server-Timing' } @{ $output->[1] };
         return $output;
     }
 }
 
 #XXX Return a clone of the routing table ref, because code modifies it later
-sub _routes ($data) {
+sub _routes ( $data = {} ) {
     state %routes;
-    return clone(\%routes) if %routes;
+    return clone( \%routes ) if %routes;
 
-    if (!$data) {
+    if ( !$data ) {
         my $conf = Trog::Config::get();
-        $data    = Trog::Data->new($conf);
+        $data = Trog::Data->new($conf);
     }
     my %roots = $data->routes();
-    %routes = %Trog::Routes::HTML::routes;
+    %routes                                      = %Trog::Routes::HTML::routes;
     @routes{ keys(%Trog::Routes::JSON::routes) } = values(%Trog::Routes::JSON::routes);
     @routes{ keys(%roots) }                      = values(%roots);
 
@@ -322,7 +371,7 @@ sub _routes ($data) {
         callback => \&robots,
     };
 
-    return clone(\%routes);
+    return clone( \%routes );
 }
 
 =head2 robots

lib/Trog/Auth.pm

@@ -17,6 +17,7 @@ use Trog::Utils;
 use Trog::Log qw{:all};
 use Trog::Config;
 use Trog::SQLite;
+use Trog::Data;
 
 =head1 Trog::Auth
 
@@ -52,7 +53,7 @@ If the user has an active session, things like password reset requests should fa
 
 sub user_has_session ($user) {
     my $dbh  = _dbh();
-    my $rows = $dbh->selectall_arrayref( "SELECT session FROM sess_user WHERE user=?", { Slice => {} }, $user );
+    my $rows = $dbh->selectall_arrayref( "SELECT session FROM sess_user WHERE name=?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return 1;
 }
@@ -70,6 +71,19 @@ sub user_exists ($user) {
     return 1;
 }
 
+=head2 primary_user
+
+Returns the oldest user with the admin ACL.
+
+=cut
+
+sub primary_user {
+    my $dbh  = _dbh();
+    my $rows = $dbh->selectall_arrayref( "SELECT username FROM user_acl WHERE acl='admin' LIMIT 1", { Slice => {} } );
+    return 0 unless ref $rows eq 'ARRAY' && @$rows;
+    return $rows->[0]{username};
+}
+
 =head2 get_existing_user_data
 
 Fetch existing settings for a user.
@@ -110,6 +124,24 @@ sub username2display ($name) {
     return $rows->[0]{display_name};
 }
 
+sub username2classname ($name) {
+
+    # Just return the user's post UUID.
+    state $data;
+    state $conf;
+    $conf //= Trog::Config::get();
+    $data //= Trog::Data->new($conf);
+
+    state @userposts = $data->get( tags => ['about'], acls => [qw{admin}] );
+
+    # Users are always self-authored, you see
+
+    my $user_obj = List::Util::first { ( $_->{user} || '' ) eq $name } @userposts;
+    my $NNname   = $user_obj->{id} || '';
+    $NNname =~ tr/-/_/;
+    return "a_$NNname";
+}
+
 =head2 acls4user(STRING username) = ARRAYREF
 
 Return the list of ACLs belonging to the user.
@@ -122,6 +154,7 @@ The 'admin' ACL is the only special one, as it allows for authoring posts, confi
 sub acls4user ($username) {
     my $dbh     = _dbh();
     my $records = $dbh->selectall_arrayref( "SELECT acl FROM user_acl WHERE username = ?", { Slice => {} }, $username );
+
     return () unless ref $records eq 'ARRAY' && @$records;
     my @acls = map { $_->{acl} } @$records;
     return \@acls;
@@ -184,7 +217,7 @@ sub totp ( $user, $domain ) {
             level         => 'L',
             casesensitive => 1,
             lightcolor    => Imager::Color->new( 255, 255, 255 ),
-            darkcolor     => Imager::Color->new( 0, 0, 0 ),
+            darkcolor     => Imager::Color->new( 0,   0,   0 ),
         );
 
         my $img = $qrcode->plot($uri);
@@ -249,7 +282,7 @@ sub mksession ( $user, $pass, $token ) {
         $totp->{secret} = $secret;
         my $rc = $totp->validate_otp( otp => $token, secret => $secret, tolerance => 3, period => 30, digits => 6 );
         INFO("TOTP Auth failed for user $user") unless $rc;
-        return '' unless $rc;
+        return ''                               unless $rc;
     }
 
     # Issue cookie
@@ -290,7 +323,7 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
     die "No display name set!" unless $displayname;
     die "Username and display name cannot be the same" if $user eq $displayname;
     die "No password set for user!"                    if !$pass && !$hash;
-    die "ACLs must be array" unless is_arrayref($acls);
+    die "ACLs must be array"             unless is_arrayref($acls);
     die "No contact email set for user!" unless $contactemail;
 
     my $dbh = _dbh();

lib/Trog/Autoreload.pm

@@ -0,0 +1,36 @@
+package Trog::Autoreload;
+
+use strict;
+use warnings;
+
+use feature qw{signatures};
+
+use Linux::Perl::inotify;
+
+use Trog::Utils;
+
+sub watch_for_changes ( $dir, $interval=5 ) {
+    my $inf = Linux::Perl::inotify->new([qw{NONBLOCK}]);
+ 
+    my @dirs = ($dir);
+    my @wds;
+    foreach my $directory (@dirs) {
+        # Recursive scan for directories and setting up inotifies
+        push(@dirs, _readdir( $directory ));
+        DEBUG("Watching $directory for changes");
+        push(@wds, $inf->add( path => $directory, events => [qw{CREATE MODIFY}] ));
+    }
+    while (!$inf->read()) {
+        sleep $interval;
+    }
+    INFO("Change in $dir detected");
+    Trog::Utils::restart_parent();
+    exit 0;
+}
+
+sub _readdir ( $dir ) {
+    opendir(my $dh, $dir);
+    my @dirs = grep { -d $_ && !m/^\.+$/ } readdir($dh);
+    closedir($dh);
+    return @dirs;
+}

lib/Trog/Config.pm

@@ -21,9 +21,9 @@ our $home_cfg = "config/main.cfg";
 
 sub get {
     state $cf;
-    return $cf if $cf;
+    return $cf                           if $cf;
     $cf = Config::Simple->new($home_cfg) if -f $home_cfg;
-    return $cf if $cf;
+    return $cf                           if $cf;
     $cf = Config::Simple->new('config/default.cfg');
     return $cf;
 }

lib/Trog/Data.pm

@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 no warnings 'experimental';
-use feature qw{signatures};
+use feature qw{signatures state};
 
 #It's just a factory
 
@@ -19,11 +19,15 @@ Returns a new Trog::Data::* class appropriate to what is configured in the Trog:
 =cut
 
 sub new ( $class, $config ) {
+    state $datamodule;
+    return $datamodule if $datamodule;
+
     my $module = "Trog::Data::" . $config->param('general.data_model');
     my $req    = $module;
     $req =~ s/::/\//g;
     require "$req.pm";
-    return $module->new($config);
+    $datamodule = $module->new($config);
+    return $datamodule;
 }
 
 1;

lib/Trog/Data/FlatFile.pm

@@ -10,7 +10,6 @@ use Carp qw{confess};
 use JSON::MaybeXS;
 use File::Slurper;
 use File::Copy;
-use Mojo::File;
 use Path::Tiny();
 use Capture::Tiny qw{capture_merged};
 

lib/Trog/DataModule.pm

@@ -3,10 +3,10 @@ package Trog::DataModule;
 use strict;
 use warnings;
 
+use FindBin::libs;
+
 use List::Util;
 use File::Copy;
-use Mojo::File;
-use Plack::MIME;
 use Path::Tiny();
 use Ref::Util();
 
@@ -50,12 +50,12 @@ sub new ( $class, $config ) {
 }
 
 #It is required that subclasses implement this
-sub lang ($self)                { ... }
-sub help ($self)                { ... }
-sub read ( $self, $query = {} ) { ... }
-sub write ($self)               { ... }
-sub count ($self)               { ... }
-sub tags ($self)                { ... }
+sub lang  ($self)                { ... }
+sub help  ($self)                { ... }
+sub read  ( $self, $query = {} ) { ... }
+sub write ($self)                { ... }
+sub count ($self)                { ... }
+sub tags  ($self)                { ... }
 
 =head1 METHODS
 
@@ -131,32 +131,28 @@ sub _fixup ( $self, @filtered ) {
 
         $subj->{method} = 'GET' unless exists( $subj->{method} );
 
-        $subj->{user_class} = $user2display{ $subj->{user} };
-        $subj->{user_class} =~ tr/ /_/ if $subj->{user_class};
-
+        $subj->{user_class} = Trog::Auth::username2classname( $subj->{user} );
         $subj
     } @filtered;
 
     return @filtered;
 }
 
+sub _filter_param ( $query, $param, @filtered ) {
+    @filtered = grep { ( $_->{$param} || '' ) eq $query->{$param} } @filtered;
+    @filtered = _dedup_versions( $query->{version}, @filtered );
+    return @filtered;
+}
+
 sub filter ( $self, $query, @filtered ) {
     $query->{acls}         //= [];
     $query->{tags}         //= [];
     $query->{exclude_tags} //= [];
 
-    # If an ID is passed, just get that (and all it's prior versions)
-    if ( $query->{id} ) {
-        @filtered = grep { $_->{id} eq $query->{id} } @filtered;
-        @filtered = _dedup_versions( $query->{version}, @filtered );
-        return @filtered;
-    }
-
-    # XXX aclname and id are essentially serving the same purpose, should unify
-    if ( $query->{aclname} ) {
-        @filtered = grep { ( $_->{aclname} || '' ) eq $query->{aclname} } @filtered;
-        @filtered = _dedup_versions( $query->{version}, @filtered );
-        return @filtered;
+    # If an ID or title or acl is passed, just get that (and all it's prior versions)
+    foreach my $key (qw{id title aclname}) {
+        next unless $query->{$key};
+        return _filter_param( $query, $key, @filtered );
     }
 
     @filtered = _dedup_versions( undef, @filtered );
@@ -178,7 +174,7 @@ sub filter ( $self, $query, @filtered ) {
         grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{tags} }
-          } @$tags
+        } @$tags
     } @filtered if @{ $query->{tags} };
 
     # Filter posts *matching* the passed exclude_tag(s), if any
@@ -187,7 +183,7 @@ sub filter ( $self, $query, @filtered ) {
         !grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{exclude_tags} }
-          } @$tags
+        } @$tags
     } @filtered if @{ $query->{exclude_tags} };
 
     # Filter posts without the proper ACLs
@@ -196,7 +192,7 @@ sub filter ( $self, $query, @filtered ) {
         grep {
             my $t = $_;
             grep { $t eq $_ } @{ $query->{acls} }
-          } @$tags
+        } @$tags
     } @filtered unless grep { $_ eq 'admin' } @{ $query->{acls} };
 
     @filtered = grep { $_->{title} =~ m/\Q$query->{like}\E/i || $_->{data} =~ m/\Q$query->{like}\E/i } @filtered if $query->{like};
@@ -271,15 +267,22 @@ my $not_ref = sub {
 my $valid_cb = sub {
     my $subname = shift;
     my ($modname) = $subname =~ m/^([\w|:]+)::\w+$/;
-    eval { require $modname; } or do {
-        WARN("Post uses a callback whos module cannot be found!");
+
+    # Modules always return 0 if they succeed!
+    eval { require $modname; } and do {
+        WARN("Post uses a callback whos module ($modname) cannot be found!");
         return 0;
     };
 
     no strict 'refs';
     my $ref = eval '\&' . $subname;
     use strict;
-    return is_coderef($ref);
+    return Ref::Util::is_coderef($ref);
+};
+
+my $hashref_or_string = sub {
+    my $subj = shift;
+    return Ref::Util::is_hashref($subj) || $not_ref->($subj);
 };
 
 # TODO more strict validation of strings?
@@ -291,7 +294,6 @@ our %schema = (
     'version'    => $not_ref,
     'visibility' => $not_ref,
     'aliases'    => \&Ref::Util::is_arrayref,
-    'tiled'      => $not_ref,
 
     # title links here
     'href' => $not_ref,
@@ -312,22 +314,30 @@ our %schema = (
     # Author of the post
     'user'    => $not_ref,
     'created' => $not_ref,
+
+    # Specific to various posts below.
+
     ## Series specific parameters
     'child_form' => $not_ref,
     'aclname'    => $not_ref,
+    'tiled'      => $not_ref,
+
     ## User specific parameters
     'user_acls'      => \&Ref::Util::is_arrayref,
     'username'       => $not_ref,
     'display_name'   => $not_ref,
     'contact_email'  => $not_ref,
-    'wallpaper_file' => $not_ref,
+    'wallpaper_file' => $hashref_or_string,
+    'wallpaper'      => $not_ref,
 
     # user avatar, but does double duty in content posts as preview images on videos, etc
-    'preview_file' => $not_ref,
+    'preview_file' => $hashref_or_string,
+    'preview'      => $not_ref,
+
     ## Content specific parameters
     'audio_href' => $not_ref,
     'video_href' => $not_ref,
-    'file'       => $not_ref,
+    'file'       => $hashref_or_string,
 );
 
 sub add ( $self, @posts ) {
@@ -394,7 +404,7 @@ sub _process ($post) {
     $post->{href}      = _handle_upload( $post->{file},           $post->{id} ) if $post->{file};
     $post->{preview}   = _handle_upload( $post->{preview_file},   $post->{id} ) if $post->{preview_file};
     $post->{wallpaper} = _handle_upload( $post->{wallpaper_file}, $post->{id} ) if $post->{wallpaper_file};
-    $post->{preview} = $post->{href} if $post->{app} && $post->{app} eq 'image';
+    $post->{preview}   = $post->{href} if $post->{app} && $post->{app} eq 'image';
     delete $post->{app};
     delete $post->{file};
     delete $post->{preview_file};
@@ -426,26 +436,14 @@ sub _process ($post) {
     @{ $post->{aliases} } = List::Util::uniq( @{ $post->{aliases} } );
 
     # Handle multimedia content types
-    if ( $post->{href} ) {
-        my $mf  = Mojo::File->new("www/$post->{href}");
-        my $ext = '.' . $mf->extname();
-        $post->{content_type} = Plack::MIME->mime_type($ext) if $ext;
-    }
-    if ( $post->{video_href} ) {
-        my $mf  = Mojo::File->new("www/$post->{video_href}");
-        my $ext = '.' . $mf->extname();
-        $post->{video_content_type} = Plack::MIME->mime_type($ext) if $ext;
-    }
-    if ( $post->{audio_href} ) {
-        my $mf  = Mojo::File->new("www/$post->{audio_href}");
-        my $ext = '.' . $mf->extname();
-        $post->{audio_content_type} = Plack::MIME->mime_type($ext) if $ext;
-    }
+    $post->{content_type}       = Trog::Utils::mime_type("www/$post->{href}")       if $post->{href};
+    $post->{video_content_type} = Trog::Utils::mime_type("www/$post->{video_href}") if $post->{video_href};
+    $post->{audio_content_type} = Trog::Utils::mime_type("www/$post->{audio_href}") if $post->{audio_href};
     $post->{content_type} ||= 'text/html';
 
-    $post->{is_video} = 1 if $post->{content_type} =~ m/^video\//;
-    $post->{is_audio} = 1 if $post->{content_type} =~ m/^audio\//;
-    $post->{is_image} = 1 if $post->{content_type} =~ m/^image\//;
+    $post->{is_video}   = 1 if $post->{content_type} =~ m/^video\//;
+    $post->{is_audio}   = 1 if $post->{content_type} =~ m/^audio\//;
+    $post->{is_image}   = 1 if $post->{content_type} =~ m/^image\//;
     $post->{is_profile} = 1 if grep { $_ eq 'about' } @{ $post->{tags} };
 
     return $post;

lib/Trog/FileHandler.pm

@@ -7,19 +7,12 @@ no warnings 'experimental';
 use feature qw{signatures};
 
 use POSIX qw{strftime};
-use Mojo::File;
-use Plack::MIME;
 use IO::Compress::Gzip;
 use Time::HiRes qw{tv_interval};
 
 use Trog::Log qw{:all};
 use Trog::Vars;
-
-#TODO consider integrating libfile
-#Stuff that isn't in upstream finders
-my %extra_types = (
-    '.docx' => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document',
-);
+use Trog::Utils;
 
 =head2 serve
 
@@ -28,17 +21,12 @@ Serve a file, with options to stream and cache the output.
 =cut
 
 sub serve ( $fullpath, $path, $start, $streaming, $ranges, $last_fetch = 0, $deflate = 0 ) {
-    my $mf  = Mojo::File->new($path);
-    my $ext = '.' . $mf->extname();
-    my $ft;
-    if ($ext) {
-        $ft = Plack::MIME->mime_type($ext) if $ext;
-        $ft ||= $extra_types{$ext} if exists $extra_types{$ext};
-    }
+    my $ft = Trog::Utils::mime_type($path);
     $ft ||= $Trog::Vars::content_types{text};
 
     my $ct      = 'Content-type';
     my @headers = ( $ct => $ft );
+    DEBUG("$ct : $ft");
 
     #TODO use static Cache-Control for everything but JS/CSS?
     push( @headers, 'Cache-control' => $Trog::Vars::cache_control{revalidate} );

lib/Trog/Log.pm

@@ -21,12 +21,12 @@ $LOGNAME = $ENV{CUSTOM_LOG} if $ENV{CUSTOM_LOG};
 
 my $LEVEL = $ENV{WWW_VERBOSE} ? 'debug' : 'info';
 
-our $log;
-our $user;
+our ( $log, $user );
 $Trog::Log::user = 'nobody';
 $Trog::Log::ip   = '0.0.0.0';
 
 sub log_init {
+
     # By default only log requests & warnings.
     # Otherwise emit debug messages.
     my $rotate = Log::Dispatch::FileRotate->new(
@@ -46,9 +46,9 @@ sub log_init {
 
     # Send things like requests in to the stats log
     my $dblog = Trog::Log::DBI->new(
-        name => 'dbi',
+        name      => 'dbi',
         min_level => $LEVEL,
-        dbh  => _dbh(),
+        dbh       => _dbh(),
     );
 
     $log = Log::Dispatch->new();
@@ -57,9 +57,6 @@ sub log_init {
     $log->add($dblog);
 
     uuid("INIT");
-    DEBUG("If you see this message, you are running in DEBUG mode.  Turn off WWW_VERBOSE env var if you are running in production.");
-    uuid("BEGIN");
-
     return 1;
 }
 
@@ -67,8 +64,7 @@ sub log_init {
 my $rq;
 
 sub _dbh {
-    # Too many writers = lock sadness, so just give each fork it's own DBH.
-	return Trog::SQLite::dbh( 'schema/log.schema', "logs/db/$$.db" );
+    return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
 }
 
 sub is_debug {

lib/Trog/Log/DBI.pm

@@ -5,50 +5,80 @@ use warnings;
 
 use parent qw{Log::Dispatch::DBI};
 
-use Ref::Util qw{is_arrayref};
+use Ref::Util     qw{is_arrayref};
 use Capture::Tiny qw{capture_merged};
 
+use POSIX           qw{mktime};
+use POSIX::strptime qw{strptime};
+
+our ( $referer, $ua, $urchin );
+
 sub create_statement {
     my $self = shift;
 
     # This is a writable view.  Consult schema for its behavior.
-    my $sql = "INSERT INTO all_requests (uuid, date, ip_address, user, method, route, code) VALUES (?,?,?,?,?,?,?)";
+    my $sql = "INSERT INTO all_requests (uuid, date, ip_address, user, method, route, referer, ua, code) VALUES (?,?,?,?,?,?,?,?,?)";
 
     my $sql2 = "INSERT INTO messages (uuid, message) VALUES (?,?)";
     $self->{sth2} = $self->{dbh}->prepare($sql2);
 
+    my $sql3 = "INSERT INTO urchin_requests (request_uuid, utm_source, utm_medium, utm_campaign, utm_term, utm_content) VALUES (?,?,?,?,?,?)";
+    $self->{sth3} = $self->{dbh}->prepare($sql3);
+
     return $self->{dbh}->prepare($sql);
 }
 
 my %buffer;
 
 sub log_message {
-    my ($self, %params) = @_;
+    my ( $self, %params ) = @_;
 
     # Rip apart the message.  If it's got any extended info, lets grab that too.
     my $msg = $params{message};
     my $message;
-    my ($date, $uuid, $ip, $user, $method, $code, $route) = $msg =~ m!^([\w|\-|:]+) \[INFO\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (\w+) (\d+) (.+)!;
+    my ( $date, $uuid, $ip, $user, $method, $code, $route ) = $msg =~ m!^([\w|\-|:]+) \[INFO\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (\w+) (\d+) (.+)!;
 
     # Otherwise, let's mark it down in the "messages" table.  This will be deferred until the final write.
-    if (!$date) {
-        ($date, $uuid, $ip, $user, $message) = $msg =~ m!^([\w|\-|:]+) \[\w+\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (.+)!;
+    if ( !$date ) {
+        ( $date, $uuid, $ip, $user, $message ) = $msg =~ m!^([\w|\-|:]+) \[\w+\]: RequestId ([\w|\-]+) From ([\w|\.|:]+) \|(\w+)\| (.+)!;
 
         $buffer{$uuid} //= [];
-        push(@{$buffer{$uuid}}, $message);
+        push( @{ $buffer{$uuid} }, $message );
         return 1;
     }
 
     # If this is a mangled log, forget it.
     return unless $date && $uuid;
 
-    my $res = $self->{sth}->execute($uuid, $date, $ip, $user, $method, $route, $code );
+    # 2024-01-20T22:37:41Z
+    # Transform the date into an epoch so we can do math on it
+    my $fmt     = "%Y-%m-%dT%H:%M:%SZ";
+    my @cracked = strptime( $date, $fmt );
+
+    #XXX get a dumb warning otherwise
+    pop @cracked;
+    my $epoch = mktime(@cracked);
+
+    # Allow callers to set quasi-tracking parameters.
+    # We only care about this in DB context, as it's only for metrics, which are irrelevant in text logs/debugging.
+    $referer //= 'none';
+    $ua      //= 'none';
+    $urchin  //= {};
 
-    if (is_arrayref($buffer{$uuid}) && @{$buffer{$uuid}}) {
-        $self->{sth2}->bind_param_array(1, $uuid);
-        $self->{sth2}->bind_param_array(2, $buffer{$uuid});
-        $self->{sth2}->execute_array({});
+    my $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
+
+    # Dump in the accumulated messages
+    if ( is_arrayref( $buffer{$uuid} ) && @{ $buffer{$uuid} } ) {
+        $self->{sth2}->bind_param_array( 1, $uuid );
+        $self->{sth2}->bind_param_array( 2, $buffer{$uuid} );
+        $self->{sth2}->execute_array( {} );
         delete $buffer{$uuid};
+
+    }
+
+    # Record urchin data if there is any.
+    if ( %$urchin && $urchin->{utm_source} ) {
+        $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
     }
 
     return $res;

lib/Trog/Log/Metrics.pm

@@ -0,0 +1,77 @@
+package Trog::Log::Metrics;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw{signatures state};
+
+use Trog::SQLite;
+
+=head1 Trog::Log::Metrics
+
+A means for acquiring time-series representations of the data recorded by Trog::Log::DBI,
+and for reasoning about the various things that it's Urchin-compatible data can give you.
+
+=cut
+
+sub _dbh {
+    return Trog::SQLite::dbh( 'schema/log.schema', "logs/log.db" );
+}
+
+=head2 requests_per(ENUM period{second,minute,hour,day,month,year}, INTEGER num_periods, [TIME_T before], INTEGER[] @codes)
+
+Returns a data structure of the following form
+
+    {
+        labels => [TIME_STR, TIME_STR, ...],
+        data   => [INT, INT,...]
+    }
+
+Describing the # of requests for the requested $num_periods $period(s) before $before.
+
+'month' and 'year' are approximations for performance reasons; 30 day and 365 day periods.
+
+Optionally filter by response code(s).
+
+=cut
+
+sub requests_per ( $period, $num_periods, $before, @codes ) {
+    $before ||= time;
+
+    # Build our periods in seconds.
+    state %period2time = (
+        second => 1,
+        minute => 60,
+        hour   => 3600,
+        day    => 86400,
+        week   => 604800,
+        month  => 2592000,
+        year   => 31356000,
+    );
+
+    my $interval = $period2time{$period};
+    die "Invalid time interval passed." unless $interval;
+
+    my @input;
+    my $whereclause = '';
+    if (@codes) {
+        my $bind = join( ',', ( map { '?' } @codes ) );
+        $whereclause = "WHERE code IN ($bind)";
+        push( @input, @codes );
+    }
+    push( @input, $interval, $before, $num_periods );
+
+    my $query = "SELECT count(*) FROM all_requests $whereclause GROUP BY date / ? HAVING date < ? LIMIT ?";
+
+    my @results = map { $_->[0] } @{ _dbh()->selectall_arrayref( $query, undef, @input ) };
+    my $np      = @results < $num_periods ? @results : $num_periods;
+    my @labels  = reverse map { "$_ $period(s) ago" } ( 1 .. $np );
+
+    return {
+        labels => \@labels,
+        data   => \@results,
+    };
+}
+
+1;

lib/Trog/Renderer.pm

@@ -54,8 +54,8 @@ sub render ( $class, %options ) {
     $renderer = $renderers{$rendertype};
     return _yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
     return _yeet( $renderer, "Status code not provided",                 %options ) if !$options{code} && !$options{component};
-    return _yeet( $renderer, "Template data not provided", %options ) unless $options{data};
-    return _yeet( $renderer, "Template not provided",      %options ) unless $options{template};
+    return _yeet( $renderer, "Template data not provided",               %options ) unless $options{data};
+    return _yeet( $renderer, "Template not provided",                    %options ) unless $options{template};
 
     #TODO future - save the components too and then compose them?
     my $skip_save = !$options{component} || !$options{data}{route} || $options{data}{has_query} || $options{data}{user} || ( $options{code} // 0 ) != 200 || Trog::Log::is_debug();

lib/Trog/Renderer/Base.pm

@@ -12,6 +12,7 @@ use IO::Compress::Gzip;
 use Text::Xslate;
 use Trog::Themes;
 use Trog::Config;
+use Time::HiRes qw{tv_interval};
 
 =head1 Trog::Renderer::Base
 
@@ -71,7 +72,7 @@ sub render (%options) {
 
 sub headers ( $options, $body ) {
     my $query   = $options->{data};
-    my $uh      = ref $options->{headers} eq 'HASH' ? $options->{headers} : {};
+    my $uh      = ref $options->{headers} eq 'HASH'      ? $options->{headers}        : {};
     my $ct      = $options->{contenttype} eq 'text/html' ? "text/html; charset=UTF-8" : "$options->{contenttype};";
     my %headers = (
         'Content-Type'           => $ct,
@@ -79,6 +80,7 @@ sub headers ( $options, $body ) {
         'Cache-Control'          => $query->{cachecontrol} // $Trog::Vars::cache_control{revalidate},
         'X-Content-Type-Options' => 'nosniff',
         'Vary'                   => 'Accept-Encoding',
+        'Server-Timing'          => "render;dur=" . ( tv_interval( $query->{start} ) * 1000 ),
         %$uh,
     );
 

lib/Trog/Routes/HTML.pm

@@ -30,6 +30,7 @@ use Trog::Data;
 use Trog::FileHandler;
 use Trog::Themes;
 use Trog::Renderer;
+use Trog::Email;
 
 use Trog::Component::EmojiPicker;
 
@@ -73,8 +74,6 @@ our %routes = (
     #        callback => \&Trog::Routes::HTML::setup,
     #    },
 
-    # IMPORTANT: YOU MUST setup fail2ban rules for the following routes.
-    # TODO: Put a rule in fail2ban/ subdir, make say a generator for it based on the routes having fail2ban=1
     '/login' => {
         method   => 'GET',
         callback => \&Trog::Routes::HTML::login,
@@ -151,8 +150,11 @@ our %routes = (
         callback => \&Trog::Routes::HTML::processed,
         noindex  => 1,
     },
-
-    # END FAIL2BAN ROUTES
+    '/metrics' => {
+        method   => 'GET',
+        auth     => 1,
+        callback => \&Trog::Routes::HTML::metrics,
+    },
 
     #TODO transform into posts?
     '/sitemap',
@@ -239,7 +241,7 @@ Most subsequent functions simply pass content to this function.
 
 =cut
 
-sub index ( $query, $content = '', $i_styles = [] ) {
+sub index ( $query, $content = '', $i_styles = [], $i_scripts = [] ) {
     $query->{theme_dir} = $Trog::Themes::td;
 
     my $to_render = $query->{template} // $landing_page;
@@ -282,8 +284,7 @@ sub index ( $query, $content = '', $i_styles = [] ) {
 
     # Grab the avatar class for the logged in user
     if ( $query->{user} ) {
-        $query->{user_class} = Trog::Auth::username2display( $query->{user} );
-        $query->{user_class} =~ tr/ /_/;
+        $query->{user_class} = Trog::Auth::username2classname( $query->{user} );
     }
 
     state $data;
@@ -308,8 +309,9 @@ sub index ( $query, $content = '', $i_styles = [] ) {
             categories   => \@series,
             stylesheets  => \@styles,
             print_styles => \@p_styles,
+            scripts      => $i_scripts,
             show_madeby  => $Theme::show_madeby ? 1 : 0,
-            embed        => $query->{embed} ? 1 : 0,
+            embed        => $query->{embed}     ? 1 : 0,
             embed_video  => $query->{primary_post}{is_video},
             default_tags => $default_tags,
             meta_desc    => $meta_desc,
@@ -369,7 +371,7 @@ sub _build_social_meta ( $query, $title ) {
     my $social = HTML::SocialMeta->new(%sopts);
     $meta_tags = eval { $social->create($card_type) };
     $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags;
-    $meta_tags .= $extra_tags if $extra_tags;
+    $meta_tags .= $extra_tags                                if $extra_tags;
 
     print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $Trog::Themes::theme_dir && !$meta_tags;
     return ( $default_tags, $meta_desc, $meta_tags );
@@ -651,7 +653,7 @@ Renders the configuration page, or redirects you back to the login page.
 =cut
 
 sub config ( $query = {} ) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $query->{failure} //= -1;
@@ -809,7 +811,7 @@ Implements /config/save route.  Saves what little configuration we actually use
 =cut
 
 sub config_save ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     $conf->param( 'general.theme',              $query->{theme} )      if defined $query->{theme};
@@ -837,7 +839,7 @@ Clone a theme by copying a directory.
 =cut
 
 sub themeclone ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my ( $theme, $newtheme ) = ( $query->{theme}, $query->{newtheme} );
@@ -861,7 +863,7 @@ Saves posts submitted via the /post pages
 =cut
 
 sub post_save ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     my $to = delete $query->{to};
@@ -897,13 +899,24 @@ Saves / updates new users.
 =cut
 
 sub profile ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
-    #TODO allow new users to do something OTHER than be admins
-    #TODO allow username changes
-    if ( $query->{password} || $query->{contact_email} ) {
-        my @acls = Trog::Auth::acls4user( $query->{username} ) || qw{admin};
+    # Find the user's post and edit it
+    state $data;
+    $data //= Trog::Data->new($conf);
+
+    my @userposts = $data->get( tags => ['about'], acls => [qw{admin}] );
+
+    # Users are always self-authored, you see
+
+    my $user_obj = List::Util::first { ( $_->{user} || '' ) eq $query->{username} } @userposts;
+
+    if ( $query->{username} ne $user_obj->{user} || $query->{password} || $query->{contact_email} ne $user_obj->{contact_email} || $query->{display_name} ne $user_obj->{display_name} ) {
+        my $for_user = Trog::Auth::acls4user( $query->{username} );
+
+        #TODO support non-admin users
+        my @acls = @$for_user ? @$for_user : qw{admin};
         Trog::Auth::useradd( $query->{username}, $query->{display_name}, $query->{password}, \@acls, $query->{contact_email} );
     }
 
@@ -911,7 +924,16 @@ sub profile ($query) {
     $query->{user} = delete $query->{username};
     delete $query->{password};
 
-    return post_save($query);
+    # Use the display name as the title
+    $query->{title} = $query->{display_name};
+
+    my %merged = (
+        %$user_obj,
+        %$query,
+        $query->{display_name} ? ( local_href => "/users/$query->{display_name}" ) : ( local_href => $user_obj->{local_href} ),
+    );
+
+    return post_save( \%merged );
 }
 
 =head2 post_delete
@@ -921,7 +943,7 @@ deletes posts.
 =cut
 
 sub post_delete ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     state $data;
@@ -987,6 +1009,8 @@ sub avatars ($query) {
         $query->{etag} = "$posts[0]{id}-$posts[0]{version}";
     }
 
+    @posts = map { $_->{id} =~ tr/-/_/; $_->{id} = "a_$_->{id}"; $_ } @posts;
+
     return Trog::Renderer->render(
         template => 'avatars.tx',
         data     => {
@@ -1052,7 +1076,7 @@ sub posts ( $query, $direct = 0 ) {
     my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
     push( @{ $query->{user_acls} }, 'public' );
     push( @{ $query->{user_acls} }, 'unlisted' ) if $query->{id};
-    push( @{ $query->{user_acls} }, 'private' ) if $is_admin;
+    push( @{ $query->{user_acls} }, 'private' )  if $is_admin;
     my @posts;
 
     # Discover this user's visibility, so we can make them post in this category by default
@@ -1130,7 +1154,8 @@ sub posts ( $query, $direct = 0 ) {
     $query->{title} ||= @$tags && $query->{domain} ? "$query->{domain} : @$tags" : undef;
 
     #Handle paginator vars
-    my $limit       = int( $query->{limit} || 25 );
+    $query->{limit} ||= 25;
+    my $limit       = int( $query->{limit} );
     my $now_year    = ( localtime(time) )[5] + 1900;
     my $oldest_year = $now_year - 20;                  #XXX actually find oldest post year
 
@@ -1257,11 +1282,14 @@ sub _post_helper ( $query, $tags, $acls ) {
     state $data;
     $data //= Trog::Data->new($conf);
 
+    $query->{page}  ||= 1;
+    $query->{limit} ||= 25;
+
     return $data->get(
         older        => $query->{older},
         newer        => $query->{newer},
-        page         => int( $query->{page} || 1 ),
-        limit        => int( $query->{limit} || 25 ),
+        page         => int( $query->{page} ),
+        limit        => int( $query->{limit} ),
         tags         => $tags,
         exclude_tags => $query->{exclude_tags},
         acls         => $acls,
@@ -1417,8 +1445,8 @@ sub sitemap ($query) {
     @to_map = sort @to_map unless $is_index;
     my $styles = ['sitemap.css'];
 
-    $query->{title}        = "$query->{domain} : Sitemap";
-    $query->{template}     = 'sitemap.tx',
+    $query->{title}    = "$query->{domain} : Sitemap";
+    $query->{template} = 'sitemap.tx',
       $query->{to_map}     = \@to_map,
       $query->{is_index}   = $is_index,
       $query->{route_type} = $route_type,
@@ -1498,7 +1526,7 @@ Basically a thin wrapper around Pod::Html.
 =cut
 
 sub manual ($query) {
-    return see_also('/login') unless $query->{user};
+    return see_also('/login')                    unless $query->{user};
     return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
 
     require Pod::Html;
@@ -1537,6 +1565,26 @@ sub processed ($query) {
     );
 }
 
+sub metrics ($query) {
+    return see_also('/login')                    unless $query->{user};
+    return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
+
+    $query->{failure} //= -1;
+
+    return Trog::Routes::HTML::index(
+        {
+            title     => 'tCMS Metrics',
+            theme_dir => $Trog::Themes::td,
+            template  => 'metrics.tx',
+            is_admin  => 1,
+            %$query,
+        },
+        undef,
+        ['post.css'],
+        ['chart.js'],
+    );
+}
+
 # basically a file rewrite rule for themes
 sub icon ($query) {
     my $path = $query->{route};
@@ -1559,7 +1607,6 @@ sub rss_style ($query) {
         data        => $query,
         code        => 200,
     );
-
 }
 
 sub _build_themed_styles ($styles) {

lib/Trog/Routes/JSON.pm

@@ -9,10 +9,15 @@ use feature qw{signatures state};
 use Clone qw{clone};
 use JSON::MaybeXS();
 
+use Scalar::Util();
+
+use Trog::Utils();
 use Trog::Config();
 use Trog::Auth();
 use Trog::Routes::HTML();
 
+use Trog::Log::Metrics();
+
 my $conf = Trog::Config::get();
 
 # TODO de-duplicate this, it's shared in html
@@ -23,25 +28,44 @@ our %routes = (
     '/api/catalog' => {
         method     => 'GET',
         callback   => \&catalog,
-        parameters => [],
+        parameters => {},
     },
     '/api/webmanifest' => {
         method     => 'GET',
         callback   => \&webmanifest,
-        parameters => [],
+        parameters => {},
     },
     '/api/version' => {
         method     => 'GET',
         callback   => \&version,
-        parameters => [],
+        parameters => {},
     },
     '/api/auth_change_request/(.*)' => {
         method     => 'GET',
         callback   => \&process_auth_change_request,
         captures   => ['token'],
+        parameters => {
+            token => sub { my $tok = shift; $tok =~ m/[a-f|0-9|-]+/; },
+        },
         noindex    => 1,
         robot_name => '/api/auth_change_request/*',
     },
+    '/api/requests_per' => {
+        method     => 'GET',
+        auth       => 1,
+        parameters => {
+            period => sub {
+                grep {
+                    my $valid = $_;
+                    List::Util::any { $_ eq $valid } @_
+                } qw{second minute hour day week month year};
+            },
+            num_periods => \&Scalar::Util::looks_like_number,
+            before      => \&Scalar::Util::looks_like_number,
+            code        => \&Scalar::Util::looks_like_number,
+        },
+        callback => \&requests_per,
+    },
 );
 
 # Clone / redact for catalog
@@ -68,7 +92,7 @@ sub catalog ($query) {
 }
 
 sub webmanifest ($query) {
-    state $headers = { ETag => 'manifest-' . _version() };
+    state $headers  = { ETag => 'manifest-' . _version() };
     state %manifest = (
         "icons" => [
             { "src" => "$theme_dir/img/icon/favicon-32.png",  "type" => "image/png", "sizes" => "32x32" },
@@ -94,6 +118,14 @@ sub process_auth_change_request ($query) {
     );
 }
 
+sub requests_per ($query) {
+    my $code = Trog::Utils::coerce_array( $query->{code} );
+    return _render(
+        200, undef,
+        %{ Trog::Log::Metrics::requests_per( $query->{period}, $query->{num_periods}, $query->{before}, @$code ) }
+    );
+}
+
 sub _render ( $code, $headers, %data ) {
     return Trog::Renderer->render(
         code        => 200,

lib/Trog/Routes/TXT.pm

@@ -0,0 +1,50 @@
+package Trog::Routes::JSON;
+
+use strict;
+use warnings;
+
+no warnings 'experimental';
+use feature qw{signatures state};
+
+use Clone qw{clone};
+use JSON::MaybeXS();
+
+use Scalar::Util();
+
+use Trog::Utils();
+use Trog::Config();
+use Trog::Auth();
+use Trog::Routes::HTML();
+
+use Trog::Log::Metrics();
+
+my $conf = Trog::Config::get();
+
+# TODO de-duplicate this, it's shared in html
+my $theme_dir = '';
+$theme_dir = "themes/" . $conf->param('general.theme') if $conf->param('general.theme') && -d "www/themes/" . $conf->param('general.theme');
+
+our %routes = (
+    '/text/zone' => {
+        method     => 'GET',
+        callback   => \&zone,
+        parameters => {},
+        admin      => 1,
+    },
+);
+
+sub zone ($query) {
+    return _render( 200, {}, $query );
+}
+
+sub _render ( $code, $headers, %data ) {
+    return Trog::Renderer->render(
+        code        => 200,
+        data        => \%data,
+        template    => 'zone.tx',
+        contenttype => 'text/plain',
+        headers     => $headers,
+    );
+}
+
+1;

lib/Trog/SQLite.pm

@@ -47,16 +47,21 @@ sub dbh {
     $dbh //= {};
     return $dbh->{$dbname} if $dbh->{$dbname};
     File::Touch::touch($dbname) unless -f $dbname;
-    die "No such schema file '$schema' !" unless -f $schema;
-    my $qq = File::Slurper::read_text($schema);
     my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
-    $db->{sqlite_allow_multiple_statements} = 1;
-    $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
-    $db->{sqlite_allow_multiple_statements} = 0;
+
+    if ($schema) {
+        die "No such schema file '$schema' !" unless -f $schema;
+        my $qq = File::Slurper::read_text($schema);
+        $db->{sqlite_allow_multiple_statements} = 1;
+        $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
+        $db->{sqlite_allow_multiple_statements} = 0;
+    }
+
     $dbh->{$dbname} = $db;
 
     # Turn on fkeys
-    $db->do("PRAGMA foreign_keys = ON")  or die "Could not enable foreign keys";
+    $db->do("PRAGMA foreign_keys = ON") or die "Could not enable foreign keys";
+
     # Turn on WALmode
     $db->do("PRAGMA journal_mode = WAL") or die "Could not enable WAL mode";
 

lib/Trog/SQLite/TagIndex.pm

@@ -56,7 +56,7 @@ sub tags {
 
 sub add_post ( $post, $data_obj ) {
     my $dbh = _dbh();
-    build_index( $data_obj,  [$post] );
+    build_index( $data_obj, [$post] );
     build_routes( $data_obj, [$post] );
     return 1;
 }

lib/Trog/Utils.pm

@@ -4,10 +4,15 @@ use strict;
 use warnings;
 
 no warnings 'experimental';
-use feature qw{signatures};
+use feature qw{signatures state};
 
 use UUID;
 use HTTP::Tiny::UNIX();
+use Plack::MIME;
+use Mojo::File;
+use File::LibMagic;
+use Ref::Util qw{is_hashref};
+
 use Trog::Log qw{WARN};
 use Trog::Config();
 
@@ -44,4 +49,27 @@ sub uuid {
     return UUID::uuid();
 }
 
+#Stuff that isn't in upstream finders
+my %extra_types = (
+    '.docx' => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document',
+);
+
+sub mime_type ($file) {
+
+    # Use libmagic and if that doesn't work try guessing based on extension.
+    my $mt;
+    my $mf  = Mojo::File->new($file);
+    my $ext = '.' . $mf->extname();
+    $mt = Plack::MIME->mime_type($ext) if $ext;
+    $mt ||= $extra_types{$ext} if exists $extra_types{$ext};
+    return $mt                 if $mt;
+
+    # If all else fails, time for libmagic
+    state $magic = File::LibMagic->new;
+    my $maybe_ct = $magic->info_from_filename($file);
+    $mt = $maybe_ct->{mime_type} if ( is_hashref($maybe_ct) && $maybe_ct->{mime_type} );
+
+    return $mt;
+}
+
 1;

lib/Trog/Vars.pm

@@ -3,6 +3,12 @@ package Trog::Vars;
 use strict;
 use warnings;
 
+use feature qw{signatures};
+no warnings qw{experimental};
+
+use Ref::Util();
+use List::Util qw{any};
+
 #1MB chunks
 our $CHUNK_SEP  = 'tCMSep666YOLO42069';
 our $CHUNK_SIZE = 1024000;
@@ -27,4 +33,91 @@ our %cache_control = (
     static     => "public, max-age=604800, immutable",
 );
 
+our $not_ref = sub {
+    return !Ref::Util::is_ref(shift);
+};
+
+our $valid_cb = sub {
+    my $subname = shift;
+    my ($modname) = $subname =~ m/^([\w|:]+)::\w+$/;
+
+    # Modules always return 0 if they succeed!
+    eval { require $modname; } and do {
+        WARN("Post uses a callback whos module ($modname) cannot be found!");
+        return 0;
+    };
+
+    no strict 'refs';
+    my $ref = eval '\&' . $subname;
+    use strict;
+    return Ref::Util::is_coderef($ref);
+};
+
+our $hashref_or_string = sub {
+    my $subj = shift;
+    return Ref::Util::is_hashref($subj) || $not_ref->($subj);
+};
+
+# Shared Post schema
+our %schema = (
+    ## Parameters which must be in every single post
+    'title'      => $not_ref,
+    'callback'   => $valid_cb,
+    'tags'       => \&Ref::Util::is_arrayref,
+    'version'    => $not_ref,
+    'visibility' => $not_ref,
+    'aliases'    => \&Ref::Util::is_arrayref,
+
+    # title links here
+    'href' => $not_ref,
+
+    # Link to post locally
+    'local_href' => $not_ref,
+
+    # Post body
+    'data' => $not_ref,
+
+    # How do I edit this post?
+    'form' => $not_ref,
+
+    # Post is restricted to visibility to these ACLs if not public/unlisted
+    'acls' => \&Ref::Util::is_arrayref,
+    'id'   => $not_ref,
+
+    # Author of the post
+    'user'    => $not_ref,
+    'created' => $not_ref,
+);
+
+=head2 filter($data,[$schema]) = %$data_filtered
+
+Filter the provided data through the default schema, and optionally a user-provided schema.
+
+Remove unwanted params to keep data slim & secure.
+
+=cut
+
+sub filter ( $data, $user_schema = {} ) {
+    %$user_schema = (
+        %schema,
+        %$user_schema,
+    );
+
+    # Filter all the irrelevant data
+    foreach my $key ( keys(%$data) ) {
+
+        # We need to have the key in the schema, and it validate.
+        delete $data->{$key} unless List::Util::any { ( $_ eq $key ) && ( $user_schema->{$key}->( $data->{$key} ) ) } keys(%$user_schema);
+
+        #use Data::Dumper;
+        #print Dumper($data);
+
+        # All parameters in the schema are MANDATORY.
+        foreach my $param ( keys(%$user_schema) ) {
+            die "Missing mandatory parameter $param" unless exists $data->{$param};
+        }
+    }
+    return %$data;
+}
+
 1;

lib/Trog/Zone.pm

@@ -0,0 +1,152 @@
+package Trog::Zone;
+
+=head1 Trog::Zone
+
+=head2 DESCRIPTION
+
+Zonefile CRUD
+
+=cut
+
+use strict;
+use warnings;
+
+use feature qw{signatures};
+no warnings qw{experimental};
+
+use Trog::Config;
+use Trog::Data;
+use Trog::Vars;
+use Trog::SQLite;
+
+use Net::IP;
+use Ref::Util;
+
+=head2 zone($domain) = @zonedata
+
+Returns the zone data for the requested zone.
+Like any other post in TCMS it's versioned.
+
+=cut
+
+sub zone ( $domain, $version = undef ) {
+    my $conf = Trog::Config::get();
+    my $data = Trog::Data->new($conf);
+
+    my @zonedata = $data->get( tags => ['zone'], acls => [qw{admin}], title => $domain );
+    @zonedata = grep { $_->{version} == $version } @zonedata if defined $version;
+    return @zonedata;
+}
+
+=head2 addzone($domain, %options)
+
+Add a post of 'zone' type.
+
+=cut
+
+my $valid_ip = sub {
+    return Net::IP->new(shift);
+};
+
+my $valid_rev_ip = sub {
+    return shift =~ m/\.in-addr\.arpa\.$/;
+};
+
+my $valid_rev_ip6 = sub {
+    return shift =~ m/\.ip6\.arpa\.$/;
+};
+
+my $spec = {
+    ip             => $valid_ip,
+    ip6            => $valid_ip,
+    ip_reversed    => $valid_rev_ip,
+    ip6_reversed   => $valid_rev_ip6,
+    nameservers    => \&Ref::Util::is_arrayref,
+    subdomains     => \&Ref::Util::is_arrayref,
+    cnames         => \&Ref::Util::is_arrayref,
+    gsv_string     => $Trog::Vars::not_ref,
+    dkim_pkey      => $Trog::Vars::not_ref,
+    acme_challenge => $Trog::Vars::not_ref,
+};
+
+sub addzone ($query) {
+    my $domain = $query->{title};
+    return unless $domain;
+    my ($latest) = zone($domain);
+    $latest //= {};
+
+    my $conf = Trog::Config::get();
+    my $data = Trog::Data->new($conf);
+
+    #XXX TODO make this instead use @records2add, complexity demon BAD
+    my $processor = Text::Xslate->new( path => 'www/templates/text' );
+    $query->{data} = $processor->render( 'zone.tx', $query );
+
+    %$latest = (
+        %$latest,
+        Trog::Vars::filter( $query, $spec ),
+    );
+
+    $data->add($latest);
+
+    #import into pdns
+    my ( $ttl, $prio, $disabled ) = ( 300, 0, 0 );
+
+    my $insert_sql  = q{insert into records (domain_id, name, type,content,ttl,prio,disabled) select id , ?, ?, ?, ?, ?, ? from domains where name=?};
+    my @records2add = (
+        [ $query->{title},                    'SOA',  "$query->{title} soa.$query->{title} $query->{version} 10800 3600 604800 10800" ],
+        [ $query->{title},                    'A',    $query->{ip} ],
+        [ $query->{title},                    'AAAA', $query->{ip6} ],
+        [ $query->{ip_reversed},              'PTR',  $query->{title} ],
+        [ $query->{ip6_reversed},             'PTR',  $query->{title} ],
+        [ $query->{title},                    'MX',   "mail.$query->{title}" ],
+        [ "_smtps._tcp.mail.$query->{title}", 'SRV',  "5 587 ." ],
+        [ "_imaps._tcp.mail.$query->{title}", 'SRV',  "5 993 ." ],
+        [ "_pop3s._tcp.mail.$query->{title}", 'SRV',  "5 995 ." ],
+        [ "_dmarc.$query->{title}",           'TXT',  "v=DMARC1; p=reject; rua=mailto:postmaster\@$query->{title}; ruf=mailto:postmaster\@$query->{title}" ],
+        [ "mail._domainkey.$query->{title}",  'TXT',  "v=DKIM1; h=sha256; k=rsa; t=y; p=$query->{dkim_pkey}" ],
+        [ $query->{title},                    'TXT',  "v=spf1 +mx +a +ip4:$query->{ip} +ip6:$query->{ip6} -all" ],
+        [ $query->{title},                    'TXT',  "google-site-verification=$query->{gsv_string}" ],
+        [ "_acme-challenge.$query->{title}",  'TXT',  $query->{acme_challenge} ],
+        [ $query->{title},                    'CAA',  '0 issue "letsencrypt.org"' ],
+    );
+
+    push( @records2add, ( map { [ "$_.$query->{title}", "CNAME", $query->{title} ] } @{ $query->{cnames} } ) );
+    push( @records2add, ( map { [ $query->{title}, 'NS', $_ ] } @{ $query->{nameservers} } ) );
+    foreach my $subdomain ( @{ $query->{subdomains} } ) {
+        push( @records2add, [ "$subdomain->{name}.$query->{title}", 'A',    $subdomain->{ip} ] );
+        push( @records2add, [ "$subdomain->{name}.$query->{title}", 'AAAA', $subdomain->{ip6} ] );
+        push( @records2add, ( map { [ "$subdomain->{name}.$query->{title}", 'NS', $_ ] } @{ $subdomain->{nameservers} } ) );
+    }
+
+    my $dbh = _dbh();
+    $dbh->begin_work();
+    $dbh->do("DELETE FROM records") or _roll_and_die($dbh);
+    foreach my $record (@records2add) {
+        $dbh->do( $insert_sql, undef, @$record, $ttl, $prio, $disabled, $query->{title} ) or _roll_and_die($dbh);
+    }
+    $dbh->commit() or _roll_and_die($dbh);
+
+    return $latest;
+}
+
+sub delzone ($domain) {
+    my $conf = Trog::Config::get();
+    my $data = Trog::Data->new($conf);
+
+    my ($latest) = zone($domain);
+    return unless $latest;
+    return $data->delete($latest);
+}
+
+sub _dbh {
+    return Trog::SQLite::dbh( undef, "dns/zones.db" );
+}
+
+sub _roll_and_die ($dbh) {
+    my $err = $dbh->errstr;
+    $dbh->rollback();
+    die $err;
+}
+
+1;

mail/mongle_dkim_config

@@ -0,0 +1,99 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+no warnings qw{experimental};
+use feature qw{signatures};
+
+use List::Util qw{uniq};
+use Config::Simple;
+use File::Copy;
+use File::Touch;
+use DNS::Unbound;
+use Net::DNS::Packet;
+
+my @domains2add = @ARGV;
+
+my $dkim_config_file   = "/etc/opendkim.conf";
+my $trusted_hosts_file = '/etc/opendkim/TrustedHosts';
+my $keytable_file      = '/etc/opendkim/KeyTable';
+my $signing_table_file = '/etc/opendkim/SigningTable';
+
+DKIM_CONFIG: {
+    my $cfg = Config::Simple->new($dkim_config_file);
+    die "Can't open opendkim config file" unless $cfg;
+
+    $cfg->param('KeyTable',           $keytable_file );
+    $cfg->param('SigningTable',       $signing_table_file);
+    $cfg->param('ExternalIgnoreList', $trusted_hosts_file);
+    $cfg->param('InternalHosts',      $trusted_hosts_file);
+
+    # This way we support signing more than one domain
+    $cfg->delete('Domain');
+    $cfg->delete('KeyFile');
+    $cfg->delete('Selector');
+
+    File::Copy::copy($dkim_config_file, "$dkim_config_file.bak") or die "Could not back up old dkim config";
+    $cfg->save();
+
+    print "OpenDKIM config file ($dkim_config_file) changed.\n";
+}
+
+TRUSTED_HOSTS: {
+    my @hosts = read_lines( $trusted_hosts_file );
+
+    my @ips2add = grep { defined $_ } map {
+        ( domain2ips( $_, "A" ),
+        domain2ips( $_, "AAAA" ) )
+    } @domains2add;
+
+    push(@hosts, "127.0.0.1", "localhost", "::1", @domains2add, @ips2add);
+    @hosts = uniq @hosts;
+
+    backup_and_emit( $trusted_hosts_file, @hosts);
+}
+
+KEY_TABLE: {
+    my @lines = read_lines( $keytable_file );
+
+    push(@lines, (map { "mail._domainkey.$_ $_:mail:/etc/opendkim/keys/$_/mail.private" } @domains2add ) );
+    @lines = uniq @lines;
+
+    backup_and_emit($keytable_file, @lines);
+}
+
+SIGNING_TABLE: {
+    my @lines = read_lines( $signing_table_file );
+
+    push(@lines, (map { "$_ mail._domainkey.$_" } @domains2add ) );
+    @lines = uniq @lines;
+
+    backup_and_emit($signing_table_file, @lines);
+}
+
+sub read_lines( $file ) {
+    File::Touch::touch($file);
+    open(my $fh, '<', $file);
+    my @lines = map { chomp $_; $_ } readline $fh;
+    close $fh;
+    return @lines;
+}
+
+sub backup_and_emit($file, @lines) {
+    File::Copy::copy($file, "$file.bak") or die "Could not back up $file";
+    open(my $wh, '>', $file);
+    foreach my $line (@lines) {
+        print $wh "$line\n";
+    }
+    close $wh;
+    print "$file changed.\n";
+}
+
+sub domain2ips( $domain, $type ) {
+    my $resolver = DNS::Unbound->new();
+
+    my $p = $resolver->resolve( $domain, $type )->answer_packet();
+    my @rrs = Net::DNS::Packet->new( \$p )->answer;
+    return map { $_->address } @rrs;
+}

mail/mongle_dmarc_config

@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use List::Util qw{uniq};
+use Config::Simple;
+use File::Copy;
+
+my @domains2add = @ARGV;
+
+my $dmarc_config_file = "/etc/opendmarc.conf";
+
+my $cfg = Config::Simple->new($dmarc_config_file);
+die "Can't open opendmarc config file" unless $cfg;
+
+$cfg->param('IgnoreAuthenticatedClients', 'true');
+$cfg->param('RequiredHeaders',            'true');
+$cfg->param('SPFSelfValidate',            'true');
+
+my @authserv = $cfg->param('TrustedAuthservIDs');
+push(@authserv, @domains2add);
+@authserv = uniq @authserv;
+
+$cfg->param('TrustedAuthservIDs', \@authserv);
+
+File::Copy::copy($dmarc_config_file, "$dmarc_config_file.bak") or die "Could not back up old dmarc config";
+$cfg->save();
+
+print "OpenDMARC config file ($dmarc_config_file) changed.\n";

nginx/tcms.conf.tmpl

@@ -8,7 +8,7 @@ server {
     ssl_certificate_key /etc/letsencrypt/live/%SERVER_NAME%/privkey.pem;
 
     location / {
-        proxy_pass http://127.0.0.1:%SERVER_PORT%;
+        proxy_pass http://unix:%SERVER_SOCK%/run/tcms.sock:/;
         proxy_set_header Host            $host;
         proxy_set_header X-Forwarded-For $remote_addr;
     }
@@ -26,7 +26,7 @@ server {
     server_name %SERVER_NAME% www.%SERVER_NAME%;
 
     location / {
-        proxy_pass http://127.0.0.1:%SERVER_PORT%;
+        proxy_pass http://unix:%SERVER_SOCK%/run/tcms.sock:/;
         proxy_set_header Host            $host;
         proxy_set_header X-Forwarded-For $remote_addr;
     }

schema/auth.schema

@@ -29,4 +29,4 @@ CREATE TABLE IF NOT EXISTS change_request (
     processed NUMERIC DEFAULT 0
 );
 
-CREATE VIEW IF NOT EXISTS change_request_full AS SELECT cr.username, cr.type, cr.token, cr.secret, cr.processed, u.contact_email from change_request AS cr JOIN user AS u ON u.name=cr.username;
+CREATE VIEW IF NOT EXISTS change_request_full AS SELECT cr.username, u.display_name, cr.type, cr.token, cr.secret, cr.processed, u.contact_email from change_request AS cr JOIN user AS u ON u.name=cr.username;

schema/log.schema

@@ -1,41 +1,138 @@
 CREATE TABLE IF NOT EXISTS seen_hosts (
     id INTEGER PRIMARY KEY AUTOINCREMENT,
-    ip_address TEXT NOT NULL
+    ip_address TEXT NOT NULL UNIQUE
 );
 
 CREATE TABLE IF NOT EXISTS seen_users (
     id INTEGER PRIMARY KEY AUTOINCREMENT,
-    user TEXT NOT NULL
+    user TEXT NOT NULL UNIQUE
 );
 
 CREATE TABLE IF NOT EXISTS seen_routes (
     id INTEGER PRIMARY KEY AUTOINCREMENT,
     route TEXT NOT NULL,
-    method TEXT NOT NULL
+    method TEXT NOT NULL,
+    UNIQUE(route, method)
 );
 
 CREATE TABLE IF NOT EXISTS response_code (
     id INTEGER PRIMARY KEY AUTOINCREMENT,
-    code INTEGER NOT NULL
+    code INTEGER NOT NULL UNIQUE
+);
+
+CREATE TABLE IF NOT EXISTS referer (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    referer TEXT NOT NULL UNIQUE
+);
+
+CREATE TABLE IF NOT EXISTS ua (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    ua TEXT NOT NULL UNIQUE
 );
 
 CREATE TABLE IF NOT EXISTS requests (
-    uuid TEXT PRIMARY KEY,
-    date TEXT NOT NULL,
+    id INTEGER PRIMARY KEY,
+    uuid TEXT NOT NULL UNIQUE,
+    date INTEGER NOT NULL,
     host_id INTEGER NOT NULL REFERENCES seen_hosts(id) ON DELETE CASCADE,
     user_id INTEGER NOT NULL REFERENCES seen_users(id) ON DELETE CASCADE,
     route_id INTEGER NOT NULL REFERENCES seen_routes(id) ON DELETE CASCADE,
+    referer_id INTEGER NOT NULL REFERENCES referer(id) ON DELETE CASCADE,
+    ua_id INTEGER NOT NULL REFERENCES ua(id) ON DELETE CASCADE,
     response_code_id INTEGER NOT NULL REFERENCES response_code(id) ON DELETE RESTRICT
 );
 
+/* Urchin stuff - it's powerful to be able to do things in backend based on campaign, even if you use a JS frontend. */
+CREATE TABLE IF NOT EXISTS urchin_source (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    value TEXT NOT NULL UNIQUE
+);
+CREATE TABLE IF NOT EXISTS urchin_medium (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    value TEXT NOT NULL UNIQUE
+);
+CREATE TABLE IF NOT EXISTS urchin_campaign (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    value TEXT NOT NULL UNIQUE
+);
+CREATE TABLE IF NOT EXISTS urchin_term (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    value TEXT NOT NULL UNIQUE
+);
+CREATE TABLE IF NOT EXISTS urchin_content (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    value TEXT NOT NULL UNIQUE
+);
+
+CREATE TABLE IF NOT EXISTS urchin (
+    id INTEGER PRIMARY KEY AUTOINCREMENT,
+    request_id INTEGER NOT NULL UNIQUE REFERENCES requests(id) ON DELETE CASCADE,
+    source_id INTEGER NOT NULL REFERENCES urchin_source(id) ON DELETE CASCADE,
+    medium_id INTEGER REFERENCES urchin_medium(id) ON DELETE CASCADE,
+    campaign_id INTEGER REFERENCES urchin_campaign(id) ON DELETE CASCADE,
+    term_id INTEGER REFERENCES urchin_term(id) ON DELETE CASCADE,
+    content_id INTEGER REFERENCES urchin_content(id) ON DELETE CASCADE
+);
+
+CREATE VIEW IF NOT EXISTS urchin_requests AS 
+    SELECT
+        u.id,
+        r.uuid   AS request_uuid,
+        us.value AS utm_source,
+        um.value AS utm_medium,
+        uc.value AS utm_campaign,
+        ut.value AS utm_term,
+        uo.value AS utm_content
+    FROM
+        urchin AS u
+    JOIN
+        requests AS r ON u.request_id = r.id
+    JOIN
+        urchin_source AS us ON us.id = u.source_id
+    LEFT JOIN
+        urchin_medium AS um ON um.id = u.medium_id
+    LEFT JOIN
+        urchin_campaign AS uc ON uc.id = u.campaign_id
+    LEFT JOIN
+        urchin_term AS ut ON ut.id = u.term_id
+    LEFT JOIN
+        urchin_content AS uo ON uo.id = u.content_id;
+
+/* Make urchin_requests a writable view via triggers.  We will always stomp the main row, as the last update will be what we want. */
+CREATE TRIGGER IF NOT EXISTS insert_urchin_requests INSTEAD OF INSERT ON urchin_requests BEGIN
+    INSERT OR IGNORE INTO urchin_source   (value) VALUES (NEW.utm_source);
+    INSERT OR IGNORE INTO urchin_medium   (value) VALUES (NEW.utm_medium);
+    INSERT OR IGNORE INTO urchin_campaign (value) VALUES (NEW.utm_campaign);
+    INSERT OR IGNORE INTO urchin_term     (value) VALUES (NEW.utm_term);
+    INSERT OR IGNORE INTO urchin_content  (value) VALUES (NEW.utm_content);
+    INSERT OR REPLACE INTO urchin SELECT
+        NEW.id,
+        r.id  AS request_id,
+        us.id AS source_id,
+        um.id AS medium_id,
+        uc.id AS campaign_id,
+        ut.id AS term_id,
+        uo.id AS content_id
+    FROM requests AS r
+    JOIN      urchin_source   AS us ON us.value = NEW.utm_source
+    LEFT JOIN urchin_medium   AS um ON um.value = NEW.utm_medium
+    LEFT JOIN urchin_campaign AS uc ON uc.value = NEW.utm_campaign
+    LEFT JOIN urchin_term     AS ut ON ut.value = NEW.utm_term
+    LEFT JOIN urchin_content  AS uo ON uo.value = NEW.utm_content
+    WHERE r.uuid = NEW.request_uuid;
+END;
+
 CREATE VIEW IF NOT EXISTS all_requests AS
     SELECT
+        q.id,
         q.uuid,
         q.date,
         h.ip_address,
         u.user,
         r.method,
         r.route,
+        f.referer,
+        ua.ua,
         c.code
     FROM
         requests AS q
@@ -45,31 +142,42 @@ CREATE VIEW IF NOT EXISTS all_requests AS
         seen_users AS u ON q.user_id = u.id
     JOIN
         seen_routes AS r ON q.route_id = r.id
+    JOIN
+        referer AS f ON q.referer_id = f.id
+    JOIN
+        ua ON q.ua_id = ua.id
     JOIN
         response_code AS c on q.response_code_id = c.id;
 
 /* Make all_requests a writable view via triggers.  We will always stomp the main row, as the last update will be what we want. */
 CREATE TRIGGER IF NOT EXISTS insert_all_requests INSTEAD OF INSERT ON all_requests BEGIN
-    INSERT OR IGNORE  INTO response_code (code)         VALUES (NEW.code);
-    INSERT OR IGNORE  INTO seen_routes   (route,method) VALUES (NEW.route, NEW.method);
-    INSERT OR IGNORE  INTO seen_users    (user)         VALUES (NEW.user);
-    INSERT OR IGNORE  INTO seen_hosts    (ip_address)   VALUES (NEW.ip_address);
+    INSERT OR IGNORE INTO response_code (code)         VALUES (NEW.code);
+    INSERT OR IGNORE INTO seen_routes   (route,method) VALUES (NEW.route, NEW.method);
+    INSERT OR IGNORE INTO seen_users    (user)         VALUES (NEW.user);
+    INSERT OR IGNORE INTO seen_hosts    (ip_address)   VALUES (NEW.ip_address);
+    INSERT OR IGNORE INTO referer       (referer)      VALUES (NEW.referer);
+    INSERT OR IGNORE INTO ua            (ua)           VALUES (NEW.ua);
     INSERT OR REPLACE INTO requests SELECT
+        NEW.id,
         NEW.uuid,
         NEW.date,
         h.id AS host_id,
         u.id AS user_id,
         r.id AS route_id,
+        f.id AS referer_id,
+        ua.id AS ua_id,
         c.id AS response_code_id
     FROM seen_hosts AS h
     JOIN seen_users AS u ON u.user = NEW.user
     JOIN seen_routes AS r ON r.route = NEW.route AND r.method = NEW.method
+    JOIN referer AS f ON f.referer = NEW.referer
+    JOIN ua ON ua.ua = NEW.ua
     JOIN response_code AS c ON c.code = NEW.code
     WHERE h.ip_address = NEW.ip_address;
 END;
 
 /* This is just to store various messages associated with requests, which are usually errors. */
 CREATE TABLE IF NOT EXISTS messages (
-    uuid TEXT NOT NULL REFERENCES requests ON DELETE NO ACTION,
+    uuid TEXT NOT NULL REFERENCES requests(uuid) ON DELETE NO ACTION,
     message TEXT NOT NULL
 );

service-files/systemd.unit

@@ -5,5 +5,9 @@ Description=tCMS
 WantedBy=default.target
 
 [Service]
-ExecStart=starman -p __PORT__ __REPLACEME__/www/server.psgi
+User=__DOMAIN__
+ExecStart=starman --listen __REPLACEME__/run/tcms.sock __REPLACEME__/www/server.psgi
 WorkingDirectory= __REPLACEME__/
+Restart=always
+OOMPolicy=stop
+ExecReload=kill -HUP $MAINPID

tcms

@@ -1,3 +1,5 @@
 #!/bin/bash
-export PSGI_ENGINE='uwsgi'
-uwsgi --ini config/tcms.ini
+[[ -e run/tcms.pid ]] && pkill -F run/tcms.pid
+sudo www/server.psgi --listen run/tcms.sock --workers 20 --group www-data --user $USER --daemonize --pid run/tcms.pid --chroot $(pwd)
+sudo chmod 0770 run/tcms.sock
+echo "tCMS running as PID "`cat run/tcms.pid`

tcms-uwsgi

@@ -0,0 +1,7 @@
+#!/bin/bash
+[[ -e run/tcms.pid ]] && pkill -F run/tcms.pid;
+export PSGI_ENGINE='uwsgi'
+uwsgi --ini config/tcms.ini
+sudo chown $USER:www-data run/tcms.sock
+sudo chmod 0770 run/tcms.sock
+echo "tCMS running as PID "`cat run/tcms.pid`

ufw/setup-rules

@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+my $DRY_RUN = $ARGV[0] ? 1 : 0;
+
+# Build rules, apply rules.
+
+# Enable every available service.
+# Don't use tCMS on hosts that do anything else with.
+my $list = qx{ufw app list};
+my @apps = split(/\n/, $list);
+shift @apps;
+@apps = map { s/^\s+//; $_ } @apps;
+
+# Sane defaults
+my @rules = (
+    [qw{enable}],
+    [qw{default deny outgoing}],
+    [qw{default deny incoming}],
+);
+
+# Allow, but rate limit
+foreach my $app (@apps) {
+    push(@rules,
+        ["allow", $app],
+        ["limit", $app],
+    );
+}
+
+@rules = map { unshift(@{$_}, '--dry-run'); $_ } @rules if $DRY_RUN;
+@rules = map { unshift(@{$_}, 'ufw'); $_ } @rules;
+
+print Dumper(\@rules);
+
+foreach my $rule (@rules) {
+    system(@$rule);
+}

www/server.psgi

@@ -6,7 +6,12 @@ use warnings;
 #Grab our custom routes
 use FindBin::libs;
 use TCMS;
+use Trog::Autoreload;
+
+our $MASTER_PID = $$;
 
 $ENV{PSGI_ENGINE} //= 'starman';
 
 our $app = \&TCMS::app;
+
+# TODO Fork off the supervisor process Trog::Autoreload

www/templates/css/avatars.tx

@@ -1,6 +1,6 @@
 /*User Images set here*/
 : for $users -> $post {
-a.<: $post.user_class :> {
+a.<: $post.id :> {
  background-image: url(<: $post.preview :>);
  filter: progid:DXImageTransform.Microsoft.AlphaImageLoader(src='<: $post.preview :>', sizingMethod='scale');
  -ms-filter: "progid:DXImageTransform.Microsoft.AlphaImageLoader(src='<: $post.preview :>', sizingMethod='scale')"

www/templates/html/components/acls.tx

@@ -1,12 +1,6 @@
-Visibility<br />
-<select id="<: $post.id :>-visibility" class="cooltext" name="visibility">
-    : for $post_visibilities -> $visibility {
-        <option <: $post.visibility == $visibility ? 'selected' : '' :> value="<: $visibility :>"><: $visibility :></option>
-    : }
-</select>
 <div id="<: $post.id :>-aclselect" >
-    ACLs / Series<br/ >
-    <select class="cooltext" name="acls">
+    ACLs - if This is unset, only admins can edit this post.  This allows 'series authors' to edit only their pages.<br/ >
+    <select multiple class="cooltext" name="acls">
         : for $acls -> $acl {
             <option value="<: $acl.aclname :>" <: $acl.selected :> ><: $acl.aclname :></option>
         : }

www/templates/html/components/forms/blog.tx

@@ -18,6 +18,7 @@
         <form class="Submissions" action="/post/save" method="POST" enctype="multipart/form-data">
             Title *<br /><input required class="cooltext" type="text" name="title" placeholder="Iowa Man Destroys Moon" value="<: $post.title :>" />
             : include "preview.tx";
+            : include "visibility.tx";
             : include "acls.tx";
             : include "tags.tx";
             : include "form_common.tx";

www/templates/html/components/forms/file.tx

@@ -52,6 +52,7 @@
         <input type="hidden" name="href" value="<: $post.href :>" />
         : }
         : include "preview.tx";
+        : include "visibility.tx";
         : include "acls.tx";
         : include "tags.tx";
         : include "form_common.tx";

www/templates/html/components/forms/microblog.tx

@@ -35,6 +35,7 @@
             : include "preview.tx";
             Audio<br /><input class="cooltext" type="url" name="audio_href" placeholder="https://soundclod.com/static.mp3" value="<: $post.audio_href :>" />
             Video<br /><input class="cooltext" type="url" name="video_href" placeholder="https://youvimeo.tv/infomercial.mp4" value="<: $post.video_href :>" />
+            : include "visibility.tx";
             : include "acls.tx";
             : include "tags.tx";
             : include "form_common.tx";

www/templates/html/components/forms/presentation.tx

@@ -0,0 +1,40 @@
+<div class="post <: $style :>">
+    :if ( !$post.addpost ) {
+        : include "post_title.tx";
+        : include "post_tags.tx";
+
+        : if ( !$post.video_href && !$post.is_image && !$post.is_video && !$post.is_profile && $post.preview ) {
+            <img src="<: $post.preview :>" class="responsive-img" />
+        : }
+
+
+    	<div class="reveal postData responsive-text" id="postData-<: $post.id :>">
+      		<div class="slides">
+      			<: for $post.data -> slide { :>
+      				<section>
+                        <: render_it($slide) | mark_raw  :>
+                    </section>
+      			<: } :>
+      		</div>
+    	</div>
+    	<script src="scripts/reveal.js"></script>
+    	<script>
+      		Reveal.initialize();
+    	</script>
+    : }
+
+    : if ( $can_edit ) {
+        <div class="postedit">
+        : include "edit_head.tx";
+        <form class="Submissions" action="/post/save" method="POST" enctype="multipart/form-data">
+            Title *<br /><input required class="cooltext" type="text" name="title" placeholder="Iowa Man Destroys Moon" value="<: $post.title :>" />
+            : include "preview.tx";
+            : include "visibility.tx";
+            : include "acls.tx";
+            : include "tags.tx";
+            : include "form_common.tx";
+        </form>
+        : include "edit_foot.tx";
+        </div>
+    : }
+</div>

www/templates/html/components/forms/profile.tx

@@ -35,10 +35,8 @@
         : if ( $post.wallpaper ) {
         <input type="hidden" name="wallpaper" value="<: $post.wallpaper :>" />
         : }
-        Title  <br /><input class="cooltext" type="text" name="title" value="<: $post.title :>" />
         <input type="hidden" name="callback" value="Trog::Routes::HTML::users" />
-        : include "acls.tx";
-        : include "tags.tx";
+        : include "visibility.tx";
         : include "form_common.tx";
     </form>
     : include "edit_foot.tx";

www/templates/html/components/forms/series.tx

@@ -57,6 +57,7 @@
         </select>
         <input type="hidden" name="callback" value="Trog::Routes::HTML::series" />
         : include "preview.tx";
+        : include "visibility.tx";
         : include "acls.tx";
         : include "tags.tx";
         : include "form_common.tx";

www/templates/html/components/header.tx

@@ -46,6 +46,12 @@
         <!-- For highlight.js !-->
         <link rel="preload" type="text/css" href="/styles/obsidian.min.css" as="style" />
         <link rel="stylesheet" type="text/css" href="/styles/obsidian.min.css" />
+        <!-- For reveal.js !-->
+        <link rel="preload" type="text/css" href="/styles/reveal.css" as="style" />
+        <link rel="stylesheet" type="text/css" href="/styles/reveal.css" />
+        <link rel="preload" type="text/css" href="/styles/reveal-white.css" as="style" />
+        <link rel="stylesheet" type="text/css" href="/styles/reveal-white.css" />
+
         <!-- Javascript !-->
         : for $scripts -> $script {
         <script type="text/javascript" src="<: $script :>"></script>

www/templates/html/components/metrics.tx

@@ -0,0 +1,69 @@
+<div id="backoffice">
+    <script>
+        var params = { period: 'hour', num_periods: 5 };
+        addEventListener("DOMContentLoaded", (event => {
+            // Fire off the XHR to fetch the JSON payload
+            doChartXHR(params);
+        }));
+
+        addEventListener("chartXHRFinished", (event => {
+            buildChart(event.payload);
+        }));
+
+        function doChartXHR(params) {
+            const req = new XMLHttpRequest();
+            req.addEventListener("load", respondToChartXHR);
+            req.open("GET", location.protocol+'//'+location.host+"/api/requests_per"+location.search);
+            req.send();
+        };
+
+        function respondToChartXHR() {
+            var payload = this.responseText;
+            console.log(payload);
+            const ev = new Event("chartXHRFinished");
+            ev.payload = JSON.parse(payload);
+            dispatchEvent(ev);
+        };
+
+        function buildChart(payload) {
+            const ctx = document.getElementById('request_chart');
+            new Chart(ctx, {
+                type: 'bar',
+                data: {
+                    labels: payload.labels,
+                    datasets: [{
+                        label: '# Requests',
+                        data: payload.data,
+                        borderWidth: 1
+                    }]
+                },
+                options: {
+                    scales: {
+                        y: {
+                            beginAtZero: true
+                        }
+                    }
+                }
+            });
+        };
+    </script>
+    <form>
+        Period:
+        <select name=period class="cooltext" >
+            <option value="second">second</option>
+            <option value="minute">minute</option>
+            <option value="hour" selected>hour</option>
+            <option value="day">day</option>
+            <option value="week">week</option>
+            <option value="month">month</option>
+            <option value="year">year</option>
+        </select>
+        Num Periods:
+        <input name="num_periods" class="cooltext" value=5 />
+        <input type="submit" value="Go" />
+    </form>
+    <div>
+      <canvas id="request_chart"></canvas>
+    </div>
+
+</div>

www/templates/html/components/posts.tx

@@ -36,6 +36,7 @@
     </div>
 : }
 <script type="text/javascript" src="/scripts/highlight.min.js"></script>
+<script type="text/javascript" src="/scripts/reveal.js"></script>
 <script>
 document.addEventListener("DOMContentLoaded", function(){
     hljs.highlightAll();

www/templates/html/components/visibility.tx

@@ -0,0 +1,6 @@
+Visibility<br />
+<select id="<: $post.id :>-visibility" class="cooltext" name="visibility">
+    : for $post_visibilities -> $visibility {
+        <option <: $post.visibility == $visibility ? 'selected' : '' :> value="<: $visibility :>"><: $visibility :></option>
+    : }
+</select>

www/templates/html/sysbar.tx

@@ -4,6 +4,7 @@
         <a href="/"            title="Back home"     class="topbar">Home</a>
         <a href="/config"      title="Configuration" class="topbar">Settings</a>
         <a href="/manual"      title="Manual"        class="topbar">Manual</a>
+        <a href="/metrics?period=hour&num_periods=24"     title="Metrics"       class="topbar">Metrics</a>
         <a href="/totp"        title="TOTP"          class="topbar">Enable/View TOTP 2fa</a>
         <a href="/password_reset" title="Reset Auth" class="topbar">Reset Password/TOTP</a>
         <a href="/logout"      title="Logout"        class="topbar">🚪</a>

www/templates/text/zone.tx

@@ -0,0 +1,55 @@
+$TTL    300
+
+@       IN      SOA     <: $title :>. soa.<: $title :>. (
+                        <: $version :> ; Serial
+                        10800   ; Refresh
+                        3600    ; Retry
+                        604800  ; Expire
+                        10800 ) ; Minimum
+
+; NS Records.
+; These are actually academic, as the registrar is where any of this matters.
+; You'll have to also set up A / AAAA records with the IP of these NS subdos of yours.
+: for $nameservers -> $ns {
+<: $title :>. IN NS <: $ns :>.
+: }
+
+; A Records
+<: $title :>. IN A <: $ip :>
+<: $title :>. IN AAAA <: $ip6 :>
+
+; PTR - also academic.  Must be set not with your registrar, but your ISP/colo etc.
+<: $ip_reversed :> IN PTR <: $title :>
+<: $ip6_reversed :>    IN PTR <: $title :>
+
+; Subtitles. Look ma, it's a glue record!
+: for $subdomains -> $sub {
+<: $sub.name :>.<: $title :>. IN A    <: $sub.ip :>
+<: $sub.name :>.<: $title :>. IN AAAA <: $sub.ip6 :>
+:     for $sub.nameservers -> $ns {
+<: $sub.name :>.<: $title :>. IN NS   <: $ns :>
+:     }
+: }
+
+; CNAME records
+: for $cnames -> $cname {
+<: $cname :>.<: $title :>. IN CNAME <: $title :>.
+: }
+
+; MX & SRV records
+<: $title :>.    IN MX  0 mail.<: $title :>.
+_smtps._tcp.mail.<: $title :>. IN SRV 10 5 587 .
+_imaps._tcp.mail.<: $title :>. IN SRV 10 5 993 .
+_pop3s._tcp.mail.<: $title :>. IN SRV 10 5 995 .
+
+; SPF, DKIM, DMARC
+_dmarc.<: $title :>.          IN TXT "v=DMARC1; p=reject; rua=mailto:postmaster@<: $title :>; ruf=mailto:postmaster@<: $title :>"
+mail._domainkey.<: $title :>. IN TXT "v=DKIM1; h=sha256; k=rsa; t=y; p=<: $dkim_pkey :>"
+<: $title :>.                 IN TXT "v=spf1 +mx +a +ip4:<: $ip :> +ip6:<: $ip6 :> ~all"
+
+; Indexer verification
+<: $title :>.                 IN TXT "google-site-verification=<: $gsv_string :>"
+
+; LetsEncyst
+_acme-challenge.<: $title :>. IN TXT  "<: $acme_challenge :>"
+<: $title :>.                 IN CAA 0 issue "letsencrypt.org"