ikiwiki-hosting-common 0.20170622ubuntu1 / usr / share / perl5 / IkiWiki / Plugin / makesite.pm

#!/usr/bin/perl
# Allows do=makesite to be used to create a new site, and do=branchsite
# to branch an existing site.
#
# Should only be enabled on the controlsite.
package IkiWiki::Plugin::makesite;

use warnings;
use strict;
use IkiWiki 3.00;
use IkiWiki::Hosting;
use IkiWiki::Business;
use HTML::Entities;

our $DNS_READY=1;
our $DNS_NEEDED=2;
our $DNS_WRONG=3;

my @themes=(
	{name => "none",        description => "Simple"},
	{name => "blueview",    description => "BlueView"},
	{name => "actiontabs",  description => "ActionTabs"},
	{name => "goldtype",    description => "GoldType"},
);

sub import {
	hook(type => "sessioncgi", id => "makesite", call => \&sessioncgi);
}

sub sessioncgi ($$) {
	my $cgi=shift;
	my $session=shift;

	return unless defined $cgi->param("do");
	
	if ($cgi->param("do") eq "makesite") {
		makesite($cgi, $session);
	}
	elsif ($cgi->param("do") eq "branchsite") {
		makesite($cgi, $session, 1);
	}
}

sub makesite ($$;$) {
	my $cgi=shift;
	my $session=shift;
	my $branching=shift;

	IkiWiki::needsignin($cgi, $session);

	# Drop ikiwiki lock to avoid blocking other users during site
	# creation.
	IkiWiki::unlockwiki();

	# Only openid and email logins are supported.
	my $username=$session->param("name");
	if (! defined IkiWiki::openiduser($username) && ! defined IkiWiki::emailuser($username)) {
		error "not logged in using openid or email -- Currently only openid and email logins can create new sites, because the account is set as the admin of the new site."
	}

	my $internal_branchof;
	if ($branching) {
		$internal_branchof=$cgi->param("branchof");

		my $branchable=IkiWiki::Hosting::getshell("ikisite-wrapper",
			"getsetup", $internal_branchof, "branchable");
		if (! $branchable) {
			my $admins=IkiWiki::Hosting::yamlgetshell("ikisite-wrapper",
				"getsetup", $internal_branchof, "adminuser");
			if (! ref $admins ||
			    ! grep { $_ eq $session->param("name") } @$admins) {
				error "You are not allowed to branch this site.";
			}
		}
	}
	
	# Get values from form and validate.
	my ($dns_state, $internal_hostname,
	    $external_hostname, $wikiname, @alias) =
		gen_hostnames(scalar $cgi->param("hostname"),
			scalar $cgi->param("domain"),
			scalar $cgi->param("internal_hostname"));
	my $type=lc($cgi->param("type")) if defined $cgi->param("type");
	my $nonce=$cgi->param("nonce");
	my $creating=$cgi->param("creating");
	my $ready=$cgi->param("ready");
	my $site_theme=$cgi->param("site_theme");
	my $dns_ok=1 if (($dns_state == $DNS_READY) || $cgi->param("submit_nodns"));
	# The session may have an email address.
	my $email=$session->param("email");
	if (defined $cgi->param("email")) {
		$email=$cgi->param("email");
	}
	else {
		eval q{use IkiWiki::Customer};
		error $@ if $@;
		$email=IkiWiki::Customer::customer_get($username, "email");
	}
	if (defined $email) {
		eval q{use Email::Address};
		if (! $@) {
			# This email address parser should be fully RFC822
			# compliant,  and can even extract email addresses
			# out of longer strings.
			# (But no check is done that the domain is valid.)
			$email = (Email::Address->parse($email))[0];
		}
		else {
			# Most stupid fallback imaginable.
			($email) = $email=~/(.*@.*)/;
		}
		$email=undef unless defined $email && length $email;
	}

	my $acceptplan=$cgi->param("acceptplan");
	my $newplan=undef;
	if (! IkiWiki::Business::needchangeplan($username, $internal_hostname)) {
		$acceptplan=1;
	}
	else {
		# Determine price plan. For now, the user doesn't choose a
		# plan, but is just set to the cheapest plan suitable for
		# the sites they have plus the one we're making.
		$newplan=IkiWiki::Business::suggestedplan($username, $internal_hostname);
		if (defined $cgi->param("suggestedplan") &&
		    $cgi->param("suggestedplan") ne $newplan) {
			# User accepted previously suggested plan,
			# but it's changed somehow.
			$acceptplan=0;
		}
	}

	# Since site creation takes a while, it will be done in the
	# background, while the user is presented with a setup screen.
	if (! $ready && ! $creating) {
		$creating=1;

		# Precalculate a nonce to use when the site is
		# created. This allows it to be modified to
		# finalize its setup later.
		$nonce=time().':'.`uuid -v4`;
		chomp $nonce;
			
		my $pid=IkiWiki::Hosting::daemonize();
		if (!$pid) {
			# Now we're a daemon..
			my @action=("create", $internal_hostname);
			if (defined $internal_branchof) {
				@action=("branch", $internal_branchof, $internal_hostname);
			}
			$ENV{IKISITE_NONCE}=$nonce;
			IkiWiki::Hosting::getshell("ikisite-wrapper",
				@action,
				"--owner=$username",
				"--admin=http://none/", # temporary admin until setup finishes
				"--wikiname=$wikiname",
				"--createnonce",
				((defined $type && length $type) ? "--type=$type" : ()),
				);
			if ($? != 0) {
				error sprintf("failure creating %s",	
					encode_entities($internal_hostname));
			}
			else {
				exit(0);
			}
		}
	}
	else {
		# If all required user input is done, just wait for the
		# background site creation to finish.
		my $canwait=$acceptplan && $dns_ok && defined $email;

		# Check if background site creation is done by checking if
		# the site exists, is no longer locked, and has the
		# requested nonce created.
		IkiWiki::Hosting::getshell("ikisite-wrapper", "checksite", $internal_hostname,
			"--hasnonce", ($canwait ? "--wait" : ()));
		if ($? == 0) {
			$creating=0;
			$ready=1;
		}
		elsif ($canwait) {
			error sprintf("failure creating %s",
				encode_entities($internal_hostname));
		}
	}

	# Modify site, setting alias and/or external hostname.
	if ($ready && ! $creating && $acceptplan && defined $email &&
	    ((@alias || ($dns_state == $DNS_READY && defined $external_hostname)))) {
		$ENV{IKISITE_NONCE}=$nonce;
		# This rebuilds the site; pretty slow. But, not as slow as
		# site creation, so I have not tried to background it yet.
		IkiWiki::Hosting::getshell("ikisite-wrapper", "domains", $internal_hostname,
			(($dns_state == $DNS_READY && defined $external_hostname) ? "--external=$external_hostname" : ()),
			map { "--alias=$_" } @alias,
		);
		if ($dns_state == $DNS_READY && defined $external_hostname && $? != 0) {
			# Above can fail, if the DNS is not set right etc.
			$dns_state=$DNS_NEEDED 
		}
	}

	# Record when a customer signs up.
	if ($acceptplan && defined $email) {
		eval q{use IkiWiki::Customer};
		error $@ if $@;
		IkiWiki::Customer::customer_lock_write($username, sub {
			IkiWiki::Customer::customer_set($username, "currentplan", $newplan)
				if defined $newplan;
			IkiWiki::Customer::customer_set($username, "email", $email);
			# Ikiwiki also collects a nickname from openid.
			# (We'd rather have a full name, but it will do.)
			# Avoid overwriting name if it's already set, as
			# the value from openid is not very good.
			if (defined $session->param("nickname") &&
			    ! defined IkiWiki::Customer::customer_get($username, "name")) {
				IkiWiki::Customer::customer_set($username, "name",
					$session->param("nickname"));
			}
			my @accounts=IkiWiki::Customer::account_list($username);
			IkiWiki::Customer::customer_set($username, "email_list", grep { defined IkiWiki::emailuser($_) } @accounts);
			IkiWiki::Customer::customer_set($username, "openid_list",  grep { defined IkiWiki::openiduser($_) } @accounts);
			my $startdate=IkiWiki::Customer::customer_get($username, "startdate");
			if (! defined $startdate || $startdate == 0) {
				IkiWiki::Customer::customer_set($username, "startdate", time);
			}
			my $balance=IkiWiki::Customer::customer_get($username, "balance");
			if (! defined $balance) {
				IkiWiki::Customer::customer_set($username, "balance", 0);
			}
			IkiWiki::Customer::customer_commit($username);
		});
	}
	
	# Redirect to newly created site once everything is ok.
	if ($ready && ! $creating && $acceptplan && defined $email && $dns_ok) {
		# But first, save the email address, which may have been
		# changed since site creation was started. And set the
		# username as the site admin  now that they have signed up.
		# And if a theme was selected, set it.
		$ENV{IKISITE_NONCE}=$nonce;
		eval q{use YAML::Syck};
		die $@ if $@;
		IkiWiki::Hosting::getshell("ikisite-wrapper", "changesetup",
			$internal_hostname, "--set", "adminemail=$email",
			"--set-yaml", "adminuser=".Dump([$username]),
			((defined $site_theme && length $site_theme &&
			  $site_theme ne "none")
				? ("--set", "theme=$site_theme") : ()),
		);

		my $redir_url;
		if (defined $external_hostname && $dns_state == $DNS_READY) {
			$redir_url="http://$external_hostname/";
		}
		else {
			$redir_url="http://$internal_hostname/";
		}

		if (! $branching) {
			IkiWiki::Hosting::readconfig();
			my $r=$config{"welcome_redir_$type"} || $config{"welcome_redir"};
			$redir_url.=$r if defined $r;
		}

		IkiWiki::redirect($cgi, $redir_url);
		
		# Setup complete; nonce no longer needed.
		if (defined $nonce && length $nonce) {
			IkiWiki::Hosting::getshell("ikisite-wrapper", "deletenonce",
				$internal_hostname, "--nonce=$nonce");
		}
		exit(0);
	}

	# Display site setup screen.
	my $template=IkiWiki::Hosting::ikisite_template("makesite.tmpl");

	# If necessary prompt user to set up DNS for their site.
	# FIXME: It would be better if the user logged in as admin to their
	# new site, and finished the DNS setup in there, rather than
	# it all happening in here. But that needs openid singlesignin
	# for the user to not have to manually login, so I hacked this
	# into here in the meantime.
	if ($dns_state == $DNS_NEEDED) {
		$template->param(dns_needed => 1);
	}
	elsif ($dns_state == $DNS_WRONG) {
		$template->param(dns_wrong => 1);
	}
	else {
		$template->param(dns_ok => 1);
	}

	$template->param(wikiname => $wikiname);
	$template->param(hostname => $cgi->param("hostname"));
	$template->param(domain => $cgi->param("domain"));
	$template->param(internal_hostname => $internal_hostname);
	$template->param(external_hostname => $external_hostname);
	$template->param(nonce => $nonce) if length $nonce;
	$template->param(creating => $creating);
	$template->param(ready => $ready);
	$template->param(retried => 1) if $cgi->param("retry");
	$template->param(type => $type) if defined $type;
	$template->param(branching => 1) if $branching;
	$template->param(branchof => $internal_branchof) if $branching;
	if (defined $newplan) {
		$template->param(suggestedplan => $newplan);
		$template->param(suggestedplan_description =>
			IkiWiki::Business::planinfo($newplan)->{description});
		$template->param(suggestedplan_name =>
			IkiWiki::Business::planinfo($newplan)->{name});
		my $trial=IkiWiki::Business::planinfo($newplan)->{monthsfreetrial};
		$template->param(suggestedplan_monthsfreetrial => $trial)
			if $trial;
	}
	$template->param(acceptplan => $acceptplan ? 1 : 0);
	if (! $acceptplan && $cgi->param("retry")) {
		$template->param(acceptplan_error => "Required");
	}
	if (defined $site_theme && length $site_theme) {
		$template->param(site_theme => $site_theme);
	}
	else {
		$template->param(themes => [
			# Add type parameter to theme list to allow
			# links to example sites of the right type.
			map {
				$_->{type}=defined $type ? $type : "wiki";
				$_;
			} @themes
		]);
	}
	if (defined $email && $acceptplan) {
		$template->param(billing_ok => 1);
	}
	if (defined $email) {
		$template->param(email => $email);
	}
	else {
		$template->param(email_error => "Required");
	}
	
	IkiWiki::printheader($session);
	print IkiWiki::cgitemplate($cgi, "site setup", $template->output);
	exit(0);
}

sub unique_internal_hostname {
	my ($base, $defaultdomain)=@_;

	my $counter=0;
	while (1) {
		my $try=$base.($counter ? ($counter+1) : "").".".$defaultdomain;
		# ikisite sitexists does not need to run as root
		IkiWiki::Hosting::getshell("ikisite", "siteexists",  $try);
		if ($? == 0) {
			$counter++;
		}
		elsif ($? == 255) {
			# 255 is what ikisite siteexists throws on data validation error
			error sprintf("not allowed to use domain name %s",
				encode_entities($base));
		}
		else {
			return $try;
		}
	}
}

sub gen_hostnames {
	# The "hostname" can be any of: A FQDN, a hostname under
	# the defaultdomain, or a wikiname. From this, derive an internal
	# hostname, an external hostname and other aliases, and look up
	# dns state.
	#
	# If an internal hostname has already been allocated, it can
	# optionally be provided.
	my ($hostname, $defaultdomain, $internal_hostname, $force_www)=@_;
	
	my $orig_hostname=$hostname;

	my ($dns_state, $external_hostname, $wikiname, @alias);

	# ikisite validates all data later, but early cleanup and validation
	# of user-supplied data allows nicer error messages.
	$hostname =~ s/^\s+//;
	$hostname =~ s/\s+$//;
	my $www_stripped=($hostname =~ s/^www\.//i) unless $force_www;
	$wikiname=$hostname;
	$wikiname=~s/^([^.]+).*/$1/;
	$hostname=lc($hostname);
	$defaultdomain=lc($defaultdomain);
	if (! length $hostname) {
		error "hostname not set";
	}
	if (! length $defaultdomain) {
		error "empty defaultdomain";
	}
	$hostname =~ s/(^|\.)\Q$defaultdomain\E$//;
	if (! length $hostname) {
		error "illegal hostname";
	}
	$defaultdomain =~ s/[^-.a-z0-9]//g;
	if (! length $defaultdomain) {
		error "illegal defaultdomain";
	}

	if (! defined $internal_hostname) {
		# Base internal hostname on what the user entered, but with
		# anything problimatic munged. If they entered a FQDN like
		# example.com, it will be example-com. A wikiname of "My Wiki"
		# will yield mywiki.
		my $base=$hostname;
		$base =~ s/\./-/g;
		$base =~ s/[^-a-z0-9]//g;
		if (! length $base) {
			error "illegal hostname";
		}

		$internal_hostname=unique_internal_hostname($base, $defaultdomain);
	}

	my $address=IkiWiki::Hosting::host_address_or_cname($hostname, $internal_hostname);
	if (defined $address && ($address eq $internal_hostname ||
	    grep { defined $_ && $_ eq $address } IkiWiki::Hosting::site_addresses())) {
		# Hostname already exists, and its address is already
		# pointed at internal_hostname.
		$external_hostname=$hostname;
		$dns_state=$DNS_READY;
	}
	elsif (defined $address) {
		# Hostname already exists, addresss is not set right.
		$external_hostname=$hostname;
		$dns_state=$DNS_WRONG;
	}
	elsif ($hostname=~/([^.]+)\.(.+)$/ &&
	       defined IkiWiki::Hosting::host_address_or_cname($2)) {
		# Hostname does not exist, but looks like it was intended
		# to be a DNS address under a domain that has DNS
		$external_hostname=$hostname;
		$dns_state=$DNS_NEEDED;
	}
	elsif ($hostname=~/(.+)\.\w+$/) {
		# Hostname does not exist, but it seems to be a DNS address
		# with a TLD.
		$external_hostname=$hostname;
		$dns_state=$DNS_NEEDED;
	}
	else {
		# No separate external hostname.
		$external_hostname=undef;
		$dns_state=$DNS_READY;
	}

	if ($www_stripped && $dns_state != $DNS_READY) {
		# Retry without stripping www, just in case
		# www.hostname.com is set up right and hostname.com is not.
		my ($dns_state2, @rest) = gen_hostnames(
			$orig_hostname, $defaultdomain, $internal_hostname, 1);
		if ($dns_state2 == $DNS_READY) {
			return ($dns_state2, @rest);
		}
	}

	if ($www_stripped) {
		@alias=$external_hostname;
		$external_hostname="www.$external_hostname";
	}
	else {
		push @alias, "www.$external_hostname" if defined $external_hostname;
	}

	return ($dns_state, $internal_hostname,
		$external_hostname, $wikiname, @alias);
}

1