ikiwiki-hosting-web 0.20160123 / usr / bin / ikisite

#!/usr/bin/perl
package IkiWiki::Hosting;

use warnings;
use strict;
use IkiWiki;
use IkiWiki::Hosting;

my $apache_before_2_4=undef;

sub apache_before_2_4 {
	return $apache_before_2_4 if defined $apache_before_2_4;
	my $query_result = getshell('dpkg-query', '-W', 'apache2.2-common');
	if ($query_result =~ m/^apache2.2-common\s+2\.[012]\./) {
		$apache_before_2_4=1;
	}
	else {
		$apache_before_2_4=0;
	}
	return $apache_before_2_4;
}

sub meta_create {
	required => [qw{hostname}],
	options => [qw{type=s vcs=s wikiname=s owner=s admin=s adminemail=s createnonce!}],
	description => "create new site",
	section => "primary",
}
sub create {
	my $hostname=lc(shift);
	my %options=(%config, @_);

	assert_root();
	my $nonce=$ENV{IKISITE_NONCE}; # stash for later
	assert_wrapper_unsafe();

	# All inputs are verified, so that ikisite create can be run
	# from a suid wrapper.
	if (! exists $options{admin}) {
		error "must specify --admin=username";
	}
	if (! defined IkiWiki::openiduser($options{admin}) && ! defined IkiWiki::emailuser($options{admin})) {
		error "$options{admin} is not a valid openid or email";
	}
	my $owner=exists $options{owner} ? $options{owner} : $options{admin};
	if (! defined IkiWiki::openiduser($owner) && ! defined IkiWiki::emailuser($owner)) {
		error "$owner is not a valid openid or email";
	}
	if ($options{vcs} !~ /^(git)$/) {
		error "unsupported vcs $options{vcs}";
	}

	# This will also fail if the hostname is invalid.
	locksite($hostname);
	assert_siteexists($hostname, 0);

	# Avoid path traversal etc when looking up autosetup file.
	$options{type}=~s/[^-a-zA-Z0-9]//g if defined $options{type};

	if (! isemail($options{adminemail})) {
		$options{adminemail}=$config{adminemail};
	}
	if (! defined $options{wikiname} || ! length $options{wikiname}) {
		$options{wikiname}=wikiname($hostname);
	}

	# Create user
	usercreate($hostname);
	my $home = homedir($hostname);

	# Enable DNS early, to help give it time to propigate.
	enabledns($hostname);

	# Setup ikiwiki. It creates the VCS repository, and builds
	# the site. Configuration is passed in via the environment.
	$ENV{IKIWIKI_WIKINAME}=$options{wikiname};
	$ENV{IKIWIKI_HOSTNAME}=$hostname;
	$ENV{IKIWIKI_VCS}=$options{vcs};
	$ENV{IKIWIKI_REPOSITORY}=$home."/source.$options{vcs}";
	$ENV{IKIWIKI_ADMIN}=$options{admin};
	$ENV{IKIWIKI_OWNER}=$owner;
	$ENV{IKIWIKI_CREATED}=time;
	$ENV{IKIWIKI_ADMINEMAIL}=$options{adminemail};
	$ENV{IKIWIKI_SRCDIR}=srcdir($hostname);
	$ENV{IKIWIKI_DESTDIR}=destdir($hostname);
	$ENV{IKIWIKI_CGIDIR}=cgidir($hostname);
	$ENV{IKIWIKI_LOGDIR}=logdir($hostname);
	$ENV{IKIWIKI_OPENID_REALM}=$config{openid_realm};
	$ENV{IKIWIKI_GITDAEMONUSER}=$config{gitdaemonuser};
	# This is normally 06755, but for new users (with suexec) we can't use
	# suid/sgid
	$ENV{IKIWIKI_CGI_WRAPPERMODE}="0755";
	$ENV{IKIWIKI_GIT_WRAPPERMODE}="6755";
	my $autosetup=defined $options{type} ? "$config{autosetupdir}/auto-$options{type}.setup" : undef;
	if (! defined $autosetup || ! -e $autosetup) {
		$autosetup="$config{autosetupdir}/auto.setup";
	}
	add_wikilist($hostname);
	eval q{use Cwd q{abs_path}};
	$autosetup=abs_path($autosetup);
	runas(username($hostname), sub {
		chdir($home) || error "chdir $home: $!";
		shell("ikiwiki", "-setup", $autosetup);
		chmod(0600, "$home/ikiwiki.setup") || error "chmod $home/ikiwiki.setup: $!";
		chmod(0700, "$home/source") || error "chmod $home/source: $!";
	});
	
	if ($options{vcs} eq "git") {
		githooks($ENV{IKIWIKI_REPOSITORY});
	}

	createsetupbranch($hostname);

	calendar($hostname);

	enable($hostname);

	accountinglog("create", $hostname, $owner);

	if ($options{createnonce}) {
		# If IKISITE_NONCE was set to a non-dummy nonce
		# initially, create a nonce with that value.
		if (defined $nonce && $nonce ne 'dummy') {
			return createnonce($hostname, value => $nonce);
		}
		else {
			return createnonce($hostname);
		}
	}
	else {
		return 1;
	}
}

sub meta_delete {
	required => [qw{hostname}],
	options => [qw{}],
	description => "delete a site",
	section => "primary",
}
sub delete {
	my $hostname=lc(shift);
	
	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_safe($hostname);
	
	accountinglog("delete", $hostname);

	disable($hostname);
	ikiwikiclean($hostname);
	if ($config{morguedir}) {
		backup($hostname, morgue => 1);
	}
	userdelete($hostname);
}

sub meta_backup {
	required => [qw{hostname}],
	options => [qw{filename=s morgue stdout srconly}],
	description => "back up a site to the specified output",
	section => "primary",
}
sub backup {
	my $hostname=lc(shift);
	my %options=@_;
	
	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	my $file;
	if ($options{stdout}) {
		$file="/dev/stdout";
	}
	elsif ($options{morgue}) {
		if (! $config{morguedir}) {
			error "morguedir not set (configure in $config{ikisite_conffile})";
		}
		shell("mkdir", "-p", $config{morguedir});
		$file=$config{morguedir}."/$hostname.backup";
	}
	elsif (defined $options{filename}) {
		eval q{use Cwd q{abs_path}};
		error $@ if $@;
		$file=abs_path($options{filename});
	}
	else {
		error "must specify --filename=value or --morgue or --stdout"
	}
	
	# Ensure setup and wiki state are committed to the setup branch.
	# Note that since this pushes into the repo, it triggers ikiwiki
	# to run, and thus it must come before lockwiki, to avoid a
	# deadlock.
	commitsetup($hostname);

	# Lock the wiki to avoid it being in an inconsistent state
	# during backup.
	$config{wikistatedir}=srcdir($hostname)."/.ikiwiki";
	IkiWiki::lockwiki();
	
	# Generate VCS dump.
	my $vcs=getsetup($hostname, "rcs");
	my $dump=homedir($hostname)."/$vcs.dump";
	my @tobackup="$vcs.dump";
	if (-e $dump) {
		unlink($dump) || error("unlink $dump: $!");
	}
	if ($vcs eq "git") {
		chdir(repository($hostname)) || error "chdir repository: $!";
		shell("git", "bundle", "create", $dump, "--all");
		# git bundle does not preserve git's config file,
		# so that will be backed up separately.
		push @tobackup, repository($hostname)."/config";
	}
	else {
		error "backup not implemented for $vcs";
	}

	if (! $options{srconly}) {
		foreach my $ikifile (qw{indexdb userdb sessions.db transient}) {
			my $f=srcdir($hostname)."/.ikiwiki/$ikifile";
			push @tobackup, $f if -e $f;
		}
	}

	foreach my $extrafile (glob(homedir($hostname)."/.ssh/id_*"),
	                       homedir($hostname)."/.ssh/known_hosts",
		               glob(homedir($hostname)."/apache/*"),) {
		push @tobackup, $extrafile if -e $extrafile;
	}

	# Copy rootconfig into home directory so it can be included
	# in backup. Nuke ~/rootconfig if it already exists;
	# the user should not be allowed to add files to rootconfig!
	my $tmprootconfig=homedir($hostname)."/rootconfig/";
	my @rootconfigs=glob(rootconfig($hostname)."/*");
	if (@rootconfigs) {
		if (! mkdir($tmprootconfig)) {
			system("rm", "-rf", $tmprootconfig);
			if (! mkdir("rootconfig")) {
				error "failed to create $tmprootconfig directory: $!";
			}
		}

		foreach my $config (@rootconfigs) {
			shell("cp", "-a", $config, $tmprootconfig."/");
		}
		push @tobackup, $tmprootconfig;
	}

	# Store files in backup tarball.
	chdir(homedir($hostname)) || error "chdir HOME: $!";
	my $umask=umask(0277); # owner read-only backup file
	my $homedir=homedir($hostname);
	shell("tar", "cf", $file,
		map {
			# avoid full paths to home directory in tarball
			my $file=$_;
			$file=~s/\Q$homedir\E\///;
			$file;
		} @tobackup,
		"--owner=root", "--group=root");
	umask($umask);

	# Cleanup.
	unlink($dump);
	shell("rm", "-rf", $tmprootconfig);
	IkiWiki::unlockwiki();

	return; # avoid writing status to stdout
}

sub meta_restore {
	required => [qw{hostname}],
	options => [qw{filename=s morgue! stdin! no-setup! no-sshkeys!}],
	description => "restore a site from the specified input",
	section => "primary",
}
sub restore {
	my $hostname=lc(shift);
	my %options=@_;
	
	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 0);
	assert_wrapper_denied();

	my $file;
	if ($options{stdin}) {
		$file="/dev/stdin";
	}
	elsif ($options{morgue}) {
		if (! $config{morguedir}) {
			error "morguedir not set (configure in $config{ikisite_conffile})";
		}
		$file=$config{morguedir}."/$hostname.backup";
	}
	elsif (defined $options{filename}) {
		eval q{use Cwd q{abs_path}};
		error $@ if $@;
		$file=abs_path($options{filename});
	}
	else {
		error "must specify --filename=value or --morgue or --stdin"
	}

	if (! -e $file) {
		error "$file does not exist";
	}

	usercreate($hostname);
	
	# Enable DNS early, to help give it time to propigate.
	enabledns($hostname) unless $options{"no-setup"};
	
	# Extract the VCS dump from the backup tarball.
	chdir(homedir($hostname)) || error "chdir HOME: $!";
	shell("tar", "xf", $file, "--wildcards", "*.dump");
	my $dump=glob("*.dump");
	my ($vcs)=$dump=~/(.*)\.dump/;
	my $repository="source.$vcs";

	# Extract repository from VCS dump and then check out the source
	# and setup branches from VCS. Since VCS typically have issues
	# around checking out directly into an existing home directory,
	# setup is extracted into a home-tmp.
	if ($vcs eq "git") {
		shell("git", "clone", $dump, $repository, "--bare");
		# denyNonFastforwards and sharedrepository are normally
		# set by git init --shared; replicate that in our bare clone.
		chdir($repository) || error "chdir repository: $!";
		shell("git", "config", "core.sharedrepository", 1);
		shell("git", "config", "receive.denyNonFastforwards", "true");
		chdir(homedir($hostname)) || error "chdir HOME: $!";

		githooks($repository);

		shell("git", "clone", $repository, "source");
		shell("git", "clone", $repository, "home-tmp",
			"--branch", "setup");

		chmod(0700, "source") || error "chmod source: $!";
		chmod(0700, "home-tmp/.git") || error "chmod home-tmp/.git: $!";
		chmod(0600, "home-tmp/ikiwiki.setup") || error "chmod home-tmp/ikiwiki.setup: $!";
		chmod(0600, "home-tmp/.gitignore") || error "chmod home-tmp/.gitignore: $!"
			if -e "home-tmp/.gitignore";
	}
	else {
		error "restore not implemented for $vcs";
	}
	unlink($dump) || error "unlink: $!";
	
	# XXX Using rsync to merge the tree in means more disk IO
	# than strictly necessary. But is easy.
	shell("rsync", "-a", "--exclude=.ssh/", "home-tmp/", ".");

	# Extract remainder of backup tarball.
	shell("tar", "xf", $file, "--exclude", $dump);

	# Move rootconfig into place.
	if (-d "rootconfig") {
		shell("rm", "-rf", rootconfig($hostname));
		shell("mv", "rootconfig", rootconfig($hostname));
	}
	
	# Make all extracted files be owned by the user.
	my $username=username($hostname);
	shell("chown", "$username:$username", "-R", ".");

	# apache/ should be readable by www-data.
	if (-d "apache") {
		shell("chgrp", "www-data", "apache");
		chmod(0750, "apache") || error "chmod apache: $!";
	}

	if (! $options{'no-sshkeys'}) {
		# Restore ssh last, to ensure the git repo is set up
		# before any attempt is made to push changes into it.
		foreach my $file (glob("home-tmp/.ssh/*")) {
			if (-f $file) {
				shell("mv", "-f", $file,
					".ssh/".IkiWiki::basename($file));
			}
			
		}
		# ssh requires this file be mode 400, and most
		# VCS do not preserve the mode.
		shell("chmod", "400", ".ssh/authorized_keys")
			if -e ".ssh/authorized_keys";
	}
	else {
		# record that the ssh keys were dropped
		commitsetup($hostname);
	}
	
	shell("rm", "-rf", "home-tmp");
	
	if (! $options{"no-setup"}) {
		ikiwikisetup($hostname);
		enable($hostname);
		accountinglog("create", $hostname, getsetup($hostname, "owner"));
	}

	# This is the same as IkiWiki::Setup::Automator does when
	# creating a new site.
	runas($username, sub {
		mkdir(homedir($hostname)."/.ikiwiki");
		open (WIKILIST, ">", homedir($hostname)."/.ikiwiki/wikilist") || die "wikilist: $!";
		print WIKILIST $username." ".homedir($hostname)."/ikiwiki.setup\n";
		close WIKILIST;
	});
	add_wikilist($hostname);

	return 1;
}

sub meta_branch {
	required => [qw{oldhostname newhostname}],
	options => [qw{owner=s admin=s ... adminemail=s wikiname=s createnonce!}],
	description => "generate a branch of a site with a new hostname,
		optionally with a different admin",
	section => "primary",
}
sub branch {
	my $oldhostname=lc(shift);
	my $newhostname=lc(shift);
	my %options=@_;
	
	assert_root();
	my $nonce=$ENV{IKISITE_NONCE}; # stash for later
	assert_wrapper_unsafe();
	
	# All inputs are verified, so that ikisite create can be run
	# from a suid wrapper.
	my $adminchanged=0;
	my %oldadmin=map { $_ => 1 } @{getsetup($oldhostname, "adminuser")};
	my $owner=$options{owner};
	if (exists $options{admin}) {
		foreach my $admin (@{$options{admin}}) {
			if (! defined IkiWiki::openiduser($admin) && ! defined IkiWiki::emailuser($admin)) {
				error "$admin is not a valid openid or email";
			}
			if (! exists $oldadmin{$admin}) {
				$adminchanged=1;
			}
			$owner=$admin unless defined $owner;
		}
	}
	if (defined $owner && ! defined IkiWiki::openiduser($owner) && ! defined IkiWiki::emailuser($owner)) {
		error "$owner is not a valid openid or email";
	}

	# These will also fail if the hostnames are invalid.
	locksite($oldhostname);
	assert_siteexists($oldhostname, 1);
	locksite($newhostname);
	assert_siteexists($newhostname, 0);

	# The adminemail must be changed when the admin is changed.
	# If it's not valid, use the default value.
	if (exists $options{adminemail} && ! isemail($options{adminemail})) {
		$options{adminemail}=$config{adminemail};
	}
	if (! exists $options{adminemail} && $adminchanged) {
		$options{adminemail}=$config{adminemail};
	}
	
	eval q{use File::Temp};
	my ($tempfh, $tempfile) = File::Temp::tempfile(UNLINK => 1);
	backup($oldhostname, filename => $tempfile);
	restore($newhostname, filename => $tempfile, "no-setup" => 1,
		# don't include database files in branch
		# (no email subscriptions, etc)
		srconly => 1,
		# when admin is changed, do not copy ssh keys from
		# oldhostname
		"no-sshkeys" => ($adminchanged ? 1 : 0));
	
	# Enable DNS early, to help give it time to propigate.
	enabledns($newhostname);
	
	my $vcs=getsetup($oldhostname, "rcs");
	my $vcswrapper;
	# XXX this duplicates code from IkiWiki::Setup::Automator
	if ($vcs eq 'git') {
		$vcswrapper=repository($newhostname)."/hooks/post-update";
	}
	else {
		error "branch not implemented for $vcs";
	}

	# The srcdir may be inside a subdirectory of the
	# repo. If so, this should be preserved when branching.
	my $oldsrcdir=srcdir($oldhostname);
	my $oldhomedir=homedir($oldhostname);
	$oldsrcdir=~s/^\Q$oldhomedir\E\//\//;
	my $srcdir=homedir($newhostname).$oldsrcdir;
	
	my $historyurl=getsetup($oldhostname, "historyurl");
	$historyurl=~s/source\.\Q$oldhostname\E/source.$newhostname/i
		if defined $historyurl;
	my $diffurl=getsetup($oldhostname, "diffurl");
	$diffurl=~s/source\.\Q$oldhostname\E/source.$newhostname/i
		if defined $diffurl;

	my @settings;
	push @settings, set => [
		"wikiname" ."=". (exists $options{wikiname} ? $options{wikiname} : wikiname($newhostname)),
		"srcdir" ."=". $srcdir,
		"destdir" ."=". destdir($newhostname),
		"url" ."=". "http://$newhostname",
		"cgiurl" ."=". "http://$newhostname/ikiwiki.cgi",
		"openid_cgiurl" ."=". "http://$newhostname/ikiwiki.cgi",
		"cgi_wrapper" ."=". cgidir($newhostname)."/ikiwiki.cgi",
		"libdir" ."=". homedir($newhostname)."/.ikiwiki",
		$vcs."_wrapper" ."=". $vcswrapper,
		(defined $historyurl ? "historyurl" ."=". $historyurl : ()),
		(defined $diffurl ? "diffurl" ."=". $diffurl : ()),
		(exists $options{adminemail} ? "adminemail=$options{adminemail}" : ()),
		(defined $owner ? "owner=$owner" : ()),
		"created" ."=". time,
		"hostname" ."=". $newhostname,
		"parent" ."=". $oldhostname,
	];
		
	eval q{use YAML::Syck};
	die $@ if $@;
	push @settings, 'set-yaml' => [
		"urlalias=".Dump([]),
		($options{admin} ? "adminuser=".Dump($options{admin}) : ()),
		"ENV=".Dump({TMPDIR => homedir($newhostname)."/tmp"}),
	];

	# avoid git pushes from branch unless explicitly turned back on
	push @settings, 'disable-plugin' => ['gitpush'];
	
	changesetup($newhostname,
		rebuild => 1,
		commit => 1,
		message => "branched $newhostname from $oldhostname",
		@settings,
	);

	if ($options{admin}) {
		# TODO modify .ikiwiki/userdb to add new admin, if not an openid or email?
	}

	enable($newhostname);
	
	accountinglog("create", $newhostname,
	       defined $owner ? $owner : getsetup($newhostname, "owner"));
	
	if ($options{createnonce}) {
		# If IKISITE_NONCE was set to a non-dummy nonce
		# initially, create a nonce with that value.
		if (defined $nonce && $nonce ne 'dummy') {
			return createnonce($newhostname, value => $nonce);
		}
		else {
			return createnonce($newhostname);
		}
	}
	else {
		return 1;
	}
}

sub meta_rename {
	required => [qw{oldhostname newhostname}],
	options => [qw{}],
	description => "rename a site to use a different hostname",
	section => "primary",
}
sub rename {
	my $oldhostname=lc(shift);
	my $newhostname=lc(shift);
	
	assert_root();
	locksite($oldhostname);
	assert_siteexists($oldhostname, 1);
	locksite($newhostname);
	assert_siteexists($newhostname, 0);
	assert_wrapper_denied();

	branch($oldhostname, $newhostname);
	IkiWiki::Hosting::delete($oldhostname); # silly perl, not the builtin delete..

	return 1;
}

sub meta_compact {
	required => [qw{hostname}],
	options => [qw{aggressive!}],
	description => "log rotation and vcs cleanup for a site",
	section => "primary",
}
sub compact {
	my $hostname=lc(shift);
	my %options=@_;
	
	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	# log rotation
	my $log_period=getsetup($hostname, "log_period") || 7;
	$log_period = 2 if $log_period < 2; # savelog does not support 0 or 1
	chdir(logdir($hostname)) || error "chdir logs: $!";
	shell("savelog", "-p", "-n", "-t", "-c", $log_period,
		"ikisite.log", "error.log", "access.log");
	# Note that apache still has logs open, but this is ok since
	# the logs are only renamed to .0, so it can still write to them.
	# So, apache is not HUP'd -- but it would be a good idea to
	# HUP apache after running a compact cron job.
	
	# VCS optimisations
	if (getsetup($hostname, "rcs") eq "git") {
		runas(username($hostname), sub {
			foreach my $repo (repository($hostname), srcdir($hostname)) {
				chdir($repo) || error "chdir $repo: $!";
				shell("git", "gc",
					$options{aggressive} ? "--aggressive" : ());
			}
		});
	}

	return 1;
}

sub meta_list {
	required => [qw{}],
	options => [qw{admin=s ... owner=s ... extended! aggregatedue!}],
	description => "lists all sites that exist on the current host, or match a condition",
	section => "query",
}
sub list {
	my %options=@_;

	# Root is needed to read setup files in some circumstances.
	assert_root();

	# All inputs (and outputs) are safe, so this can be run from
	# a suid wrapper.
	assert_wrapper_unsafe();

	my @list;
	my %seen;
	setpwent();
	while (my $user=(getpwent())[0]) {
		my $hostname=userlookup(user => $user);
		next unless defined $hostname && length $hostname;

		$seen{$hostname}=1 if $options{extended};

		my $owner;
		my %admins;
		if ($options{extended} || $options{owner} || $options{admin}) {
			# avoid list crashing if setup file is broken
			eval { $owner=getsetup($hostname, "owner") };
			next if $@;
			%admins=map { $_ => 1 } @{getsetup($hostname, "adminuser")};
		}

		my $isowner=defined $options{owner} && grep { $_ eq $owner } @{$options{owner}};
		next if defined $options{owner} && ! $isowner && ! defined $options{admin};
		my $isadmin=defined $options{admin} && grep { $admins{$_} } @{$options{admin}};
		next if defined $options{admin} && ! $isowner && ! $isadmin;

		if ($options{aggregatedue}) {
			my $timestamp=eval { readfile(srcdir($hostname)."/.ikiwiki/aggregatetime") };
			next unless defined $timestamp && length $timestamp && $timestamp <= time();
		}

		if (! $options{extended}) {
			push @list, $hostname;
		}
		else {
			# Extended mode includes the information the
			# controlpanel module needs, as well as some
			# information needed by other programs.
			my @admins=@{getsetup($hostname, "adminuser")};
			my $unfinished=0; # unfinished site will have dummy admin
			if (@admins && ! grep { $_ ne "http://none/" } @admins) {
				$unfinished=1;
			}
			push @list, {
				isowner => $isowner,
				isadmin => $isadmin,
				site_owner => $owner, 
				site_hostname => $hostname,
				site_url => getsetup($hostname, "url"),
				site_cgiurl => getsetup($hostname, "cgiurl"),
				site_wikiname => getsetup($hostname, "wikiname"),
				site_created => getsetup($hostname, "created"),
				site_parent => getsetup($hostname, "parent"),
				isunfinished => $unfinished,
			};
		}
	}

	return @list unless $options{extended};

	# Filter no longer existing parents.
	foreach my $siteinfo (@list) {
		my $parent=$siteinfo->{site_parent};
		if (defined $parent && ! $seen{$parent}) {
			$siteinfo->{site_parent} = undef;
		}
	}

	return \@list; # complex data structure
}

sub meta_userlookup {
	required => [qw{}],
	options => [qw{user=s}],
	description => "returns the internal hostname corresponding to a unix username",
	section => "query",
}
{
my %prefixes;
sub userlookup {
	my %options=@_;
	
	assert_wrapper_unsafe();
	
	if (! exists $options{user} || ! length $options{user}) {
		error "specify user to lookup with --user";
	}

	if (! keys %prefixes) {
		foreach my $key (keys %config) {
			if ($key =~ /^prefix_(.*)/) {
				$prefixes{$1}=$config{$key};
			}
		}
	}

	foreach my $prefix (keys %prefixes) {
		if ($options{user}=~/^\Q$prefix\E-(.*)/) {
			return "$1.$prefixes{$prefix}";
		}
		elsif ($options{user}=~/^\Q$prefix\E5-(.*)/) {
			# md5'd username; look up real hostname
			# in setup file, and ensure it md5sums
			# to the same username.
			my $homedir=(getpwnam($options{user}))[7];
			if (defined $homedir && -e "$homedir/ikiwiki.setup") {
				foreach my $url (urllist($options{user})) {
					my $host=$url->host;
					if ($host=~/^(([a-z0-9][-a-z0-9]+)\.)\Q$prefixes{$prefix}\E$/ &&
					    $options{user} eq username($host)) {
					    	return $url->host;
					}
				}
			}
			print STDERR "cannot determine hostname for user $options{user}\n";
		}
	}
	return "";
}
}


sub meta_sitelookup {
	required => [qw{}],
	options => [qw{site=s}],
	description => "returns the internal hostname for an url or external hostname",
	section => "query",
}
sub sitelookup {
	my %options=@_;
	
	# Root is needed to read setup files in some circumstances.
	assert_root();
	assert_wrapper_unsafe();
	
	if (! exists $options{site} || ! length $options{site}) {
		error "specify site to lookup with --site";
	}

	eval q{use URI};
	my $url=URI->new($options{site});
	my $host=$url->can("host") ? $url->host : $options{site};

	if (eval { sitexists($host) } && ! $@) {
		return $host;
	}

	foreach my $hostname (list()) {
		foreach my $url (urllist(username($hostname))) {
			if (lc $url->host eq lc $host) {
				return $hostname;
			}
		}
	}

	error "$host not found";
}


sub meta_siteexists {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns true if the hostname already exists",
	section => "query",
}
sub siteexists {
	my $hostname=lc(shift);
	
	my $user=username($hostname);

	# TODO Assumes one server. To handle multiple servers, will need to
	# query DNS or a database of sites.
	my $uid=getpwnam($user);
	return defined $uid ? IkiWiki::SuccessReason->new("$hostname exists")
	                    : IkiWiki::FailReason->new("$hostname does not exist (user $user not found)");
}

sub meta_username {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the unix username for a site",
	section => "query",
}
sub username {
	my $hostname=lc(shift);
	
	# paranoia: make sure the hostname looks like a FQDN
	if ($hostname !~ /^([a-z0-9][-a-z0-9]*)\.\w+(\.\w+)+$/) {
		error "illegal hostname \"$hostname\"";
	}
	if (length $hostname > 252) { # why not 253? Trailing dot..
		error "hostname too long \"$hostname\"";
	}

	# since unix usernames are limited to 32 characters (see utmp(5))
	# chop off the subdomain of the hostname, and use that as the
	# username
	my ($subdomain, $topdomain)=$hostname=~/^([a-z0-9][-a-z0-9]*)\.(.*)/;

	# add unique prefix to avoid collisions with system users and 
	# other top domains
	my $prefix;
	foreach my $key (keys %config) {
		next unless $key =~ m/^prefix_/;
		next unless defined $config{$key};
		next unless $config{$key} eq $topdomain;
		$prefix=$key;
		$prefix=~s/^prefix_//;
		last;
	}
	if (! $prefix) {
		error "unknown prefix for $topdomain (configure in $config{ikisite_conffile})";
	}
	my $username=$prefix.'-'.$subdomain;

	if (length($username) > 32) {
		# Fall back to using a hash for longer subdomains.
		eval q{use Digest::MD5};
		die $@ if $@;

		my $md5=Digest::MD5::md5_hex($subdomain);
		$username=$prefix.'5-'.substr($md5, 0, 16).'-'.
			substr($subdomain, 0, 12);
	}

	return $username;
}

sub meta_homedir {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the home directory for a site",
	section => "query",
}
sub homedir {
	my $hostname=lc(shift);
	
	return (getpwnam(username($hostname)))[7];
}

sub meta_srcdir {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the ikiwiki srcdir for a site",
	section => "query",
}
sub srcdir {
	my $hostname=shift;
	
	# Normally it is ~/srcdir, but the setup file can be modified 
	# to only use a subdirectory of that.
	if (-e homedir($hostname)."/ikiwiki.setup") {
		return getsetup($hostname, "srcdir");
	}
	else {
		return homedir($hostname)."/source";
	}
}

sub meta_destdir {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the ikiwiki destdir for a site",
	section => "query",
}
sub destdir {
	my $hostname=shift;

	return homedir($hostname)."/public_html";
}

sub meta_cgidir {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the CGI directory for a site",
	section => "query",
}
sub cgidir {
	my $hostname=shift;
	my $newly_created=shift;
	my $dir = "/var/www/".username($hostname);

	if ($newly_created || -d $dir) {
		return $dir;
	}

	return homedir($hostname)."/public_html";
}

sub meta_logdir {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the server log directory for a site",
	section => "query",
}
sub logdir {
	my $hostname=shift;
	my $newly_created=shift;
	my $dir = userlogdir(username($hostname));

	if ($newly_created || -d $dir) {
		return $dir;
	}

	my $home=homedir($hostname);
	return unless defined $home;
	return $home."/logs";
}

sub userlogdir {
	my $username=shift;
	return "/var/log/ikiwiki-hosting/".$username;
}

sub meta_rootconfig {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the root configuration directory of the site",
	section => "query",
}
sub rootconfig {
	my $hostname=lc(shift);
	
	return $config{ikisite_rootconfigdir}."/".username($hostname);
}

sub meta_wikiname {
	required => [qw{hostname}],
	options => [qw{}],
	description => "calculates the default wikiname to use for a site",
	section => "query",
}
sub wikiname {
	my $hostname=shift;
	
	my ($wikiname)=$hostname=~/^([a-zA-Z0-9][-a-zA-Z0-9_]*)\./;
	return $wikiname;
}

sub meta_repository {
	required => [qw{hostname}],
	options => [qw{}],
	description => "returns the vcs repository for a site",
	section => "query",
}
sub repository {
	my $hostname=lc(shift);
	
	return homedir($hostname)."/source.".getsetup($hostname, "rcs");
}

sub meta_getsetup {
	required => [qw{hostname key}],
	options => [qw{}],
	description => "returns a value from the site's ikiwiki.setup",
	section => "query",
}

my ($getsetup_cache_setup, $getsetup_homedir_old); # memoized for speed
sub getsetup {
	my $hostname=shift;
	my $key=shift;
	my %options=@_;
	
	# The suid wrapper can only be used to access a few values.
	if ($key eq 'branchable' || $key eq 'adminuser') {
		assert_wrapper_unsafe();
	}
	else {
		assert_wrapper_denied();
	}
	
	my $homedir;
	# this option is used internally, when the hostname is not known
	if (exists $options{user}) {
		$homedir=(getpwnam($options{user}))[7];
	}
	else {
		$hostname=lc($hostname);
		assert_siteexists($hostname, 1);
		$homedir=homedir($hostname);
	}

	if (! defined $getsetup_homedir_old ||
	    $homedir ne $getsetup_homedir_old) {
		$getsetup_cache_setup=loadsetup_safe($homedir."/ikiwiki.setup");
		# Only keep cache if setup was successfully loaded.
		if (keys %$getsetup_cache_setup) {
			$getsetup_homedir_old=$homedir;
		}
	}

	return $getsetup_cache_setup->{$key};
}

sub meta_changesetup {
	required => [qw{hostname}],
	options => [qw{set=key=value ... set-yaml=key=value ... enable-plugin=s ... disable-plugin=s ... rebuild! commit! message=s}],
	description => "changes settings in the site's ikiwiki.setup",
	section => "utility",
}
sub changesetup {
	my $hostname=lc(shift);
	my %options=@_;
		
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_safe($hostname);

	runas(username($hostname), sub {
		my $home=homedir($hostname);
		chdir($home) || error "chdir $home: $!";
		my $cgi_wrapper=getsetup($hostname, "cgi_wrapper");
		my $srcdir=srcdir($hostname);
	
		my @settings;
		my $changedesc="changed ";
		foreach my $type (qw{set set-yaml}) {
			next unless $options{$type};
			while (@{$options{$type}}) {
				my ($key, $value)=split("=", shift @{$options{$type}}, 2);
				if (! length $key) {
					error "no key specified";
				}
				if (! defined $value) {
					error "no value specified for $key";
				}
				$changedesc.="$key to '$value' ;";
				if ($key eq "cgi_wrapper") {
					$cgi_wrapper=$value;
				}
				elsif ($key eq "srcdir") {
					$srcdir=$value;
				}
				push @settings, "--$type", "$key=$value";
			}
		}
		
		if ($options{"enable-plugin"} || $options{"disable-plugin"}) {
			my @add_plugins=@{getsetup($hostname, "add_plugins")};
			my @disable_plugins=@{getsetup($hostname, "disable_plugins")};
			foreach my $plugin (@{$options{"enable-plugin"}}) {
				$changedesc.="$plugin (enabled) ;";
				@disable_plugins=grep { $_ ne $plugin } @disable_plugins;
				push @add_plugins, $plugin unless grep { $_ eq $plugin } @add_plugins;
			}
			foreach my $plugin (@{$options{"disable-plugin"}}) {
				$changedesc.="$plugin (disabled) ;";
				@add_plugins=grep { $_ ne $plugin } @add_plugins;
				push @disable_plugins, $plugin unless grep { $_ eq $plugin } @disable_plugins;
			}
			eval q{use YAML::Syck};
			die $@ if $@;

			push @settings, "--set-yaml", "add_plugins=".
				Dump(\@add_plugins);
			push @settings, "--set-yaml", "disable_plugins=".
				Dump(\@disable_plugins);
		}

		$changedesc=~s/ ;$//;
		$changedesc=$options{message} if exists $options{message};
	
		# There's a potential race with websetup; if a websetup
		# change is taking place at the same time, ikiwiki will
		# be running with the old configuration, and will write
		# a version of that back out to the setup file, overwriting
		# our changes.
		#
		# Simply calling lockwiki() will not help, because ikiwiki
		# could still start up, with the old configuration.
		# Instead, we need to prevent the ikiwiki cgi from running
		# (at least for websetup) while the setup file is being
		# changed.
		#
		# To accomplish that, let's first take the cgilock,
		# to ensure no cgi is currently running. Note that this assumes
		# that perl flock() really calls flock(2), which is currently
		# the case in Debian, but not guaranteed of all perls.
		$config{wikistatedir}="$srcdir/.ikiwiki";
		if (-d $config{wikistatedir}) {
			open(CGILOCK, ">", "$config{wikistatedir}/cgilock") ||
				error("$config{wikistatedir}/cgilock: $!");
			flock(CGILOCK, 2) || error("flock: $!");
		}

		# Now, replace the cgi wrapper with a program that waits
		# for the cgilock to free up, and then re-execs the cgi
		# wrapper, loading the new wrapper we will generate,
		# with the changed configuration.
		if (-e $cgi_wrapper) {
			link($cgi_wrapper, $cgi_wrapper.".old") || error("$cgi_wrapper.old: $!");
			open(OUT, ">", $cgi_wrapper.".tmp") || error("$cgi_wrapper.tmp: $!");
			print OUT qq{#!/usr/bin/perl
				# Temporary wrapper inserted by ikisite changesetup.
				open(LOCK, ">", "$config{wikistatedir}/cgilock") ||
					die "error opening $config{wikistatedir}/cgilock";
				flock(LOCK, 2) || die "flock error";
				close LOCK;
				# When this is reached, the new wrapper has
				# replaced this program.
				exec(\$0, \@ARGV);
				die "exec: \$!";
			};
			close OUT || error("close: $!");
			shell("chmod", "755", $cgi_wrapper.".tmp");
			my $user=username($hostname);
			shell("chown", "$user:$user", $cgi_wrapper.".tmp");
			CORE::rename($cgi_wrapper.".tmp", $cgi_wrapper) || error("rename: $!");
		}

		my $setupfile=homedir($hostname)."/ikiwiki.setup";
		my $oldsetup=readfile($setupfile);
		eval {
			shell("ikiwiki", "-setup", $setupfile,
				"-dumpsetup", $setupfile,
				@settings);
			ikiwikisetup($hostname, refresh => 1, wrappers => 1);
		};
		if ($@) {
			# error unwind
			if (-e $cgi_wrapper.".old") {
				CORE::rename($cgi_wrapper.".old", $cgi_wrapper) || error("rename: $!");
			}
			writefile($setupfile, "", $oldsetup);
			error $@;
		}
		unlink $cgi_wrapper.".old";
		
		close CGILOCK; # Now any CGIs that were waiting to start up can run.

		if ($options{rebuild}) {
			ikiwikisetup($hostname);
		}
		
		if ($options{commit}) {
			commitsetup($hostname, message => $changedesc);
		}
	});

	$getsetup_homedir_old=undef; # memoized setup values no longer valid

	return 1;
}

sub meta_domains {
	required => [qw{hostname}],
	options => [qw{external=s alias=s ...}],
	description => "configure a site's external domain name and aliases",
	section => "utility",
}
sub domains {
	my $hostname=lc(shift);
	my %options=@_;

	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_safe($hostname);
	
	# This subcommand can be run from a suid wrapper so inputs
	# cannot be trusted; check and sanitize.
	my @urlalias;
	my @settings;
	my $rebuild=0;
	if (defined $options{external}) {
		if (isinternaldomain($options{external})) {
			error "$options{external} is a reserved hostname";
		}

		# The external domain name does need to be configured
		# correctly in the DNS.
		my $address=host_address_or_cname($options{external}, $hostname);
		if (! defined $address) {
			print STDERR "DNS not correctly configured for $options{external}. (Should point to $hostname)\n";
			exit 2; # special code
		}
		if ($address ne $hostname) {
			if (! grep { defined $_ && $_ eq $address } site_addresses()) {
				print STDERR "DNS not configured correctly for $options{external} - $address\n";
				exit 3; # special code
			}
			else {
				print STDERR "warning: DNS for $options{external} hardcodes IP $address\n";
			}
		}
		
		# It can't be a name used by another site.
		my $exists=eval{ sitelookup(site => $options{external}) };
		if (! $@ && defined $exists && $exists ne $hostname) {
			error "$options{external} is in use by $exists";
		}

		if (getsetup($hostname, "url") ne "http://$options{external}/") {
			push @settings, 'set' => [
				"url=http://$options{external}",
				"cgiurl=http://$options{external}/ikiwiki.cgi",
			];
			$rebuild=1;
		}

		# When using an external domain, the internal hostname
		# must be listed as one of the urlaliases.
		push @urlalias, "http://$hostname/";
	}
	else {
		push @settings, 'set' => [
			"url=http://$hostname",
			"cgiurl=http://$hostname/ikiwiki.cgi",
		];
	}
	my %seen;
	foreach my $alias (@{$options{alias}}) {
		$alias=lc($alias);

		# Sanitize aliases to avoid path traversal, etc.
		if ($alias !~ /^[-.a-zA-Z0-9]+$/) {
			error "bad alias \"$alias\": illegal hostname";
		}
		# Prevent aliases being set to (possibly unused) internal
		# site names.
		if ($alias ne $hostname && isinternaldomain($alias)) {
			error "bad alias \"$alias\": reserved hostname";
		}
		# Aliases should not be in use by other sites.
		my $site=eval{ sitelookup(site => $alias) };
	       	if (defined $site && !$@ && $site ne $hostname) {
			error "alias \"$alias\": already in use by $site";
		}
		# Note that aliases do not have to be set in the DNS.
		# Eg, www.foo.com may be an alias but not set up yet,
		# and should still be accepted.
		push @urlalias, "http://$alias/" unless $seen{$alias};
		$seen{$alias}=1;
	}

	eval q{use YAML::Syck};
	die $@ if $@;
	push @settings, 'set-yaml' => [
		"urlalias=".Dump(\@urlalias),
	];

	disable($hostname, temporary => 1);
	changesetup($hostname,
		rebuild => 0, # not yet; slow
		commit => 1,
		message => "configured domains",
		@settings,
	);
	enable($hostname);

	if ($rebuild) {
		# A full site rebuild can take a long time for
		# large sites, so is postponed until after the site's
		# changed domain has been configured.
		# 
		# Unfortunatly, a long rebuild also blocks other ikiwiki
		# cgis from running. That needs to be dealt with in
		# ikiwiki, not here.
		ikiwikisetup($hostname);
	}
}

sub meta_usercreate {
	required => [qw{hostname}],
	options => [qw{}],
	description => "creates the unix user for a site",
	section => "utility",
}
sub usercreate {
	my $hostname=lc(shift);

	assert_root();
	my $lockfile=locksite($hostname);
	assert_wrapper_denied();

	my $user=username($hostname);
	my @useradd_opts = ( "--base-dir", $config{useradd_basedir} )
		if ($config{useradd_basedir}) ;
	shell("useradd", $user, 
		"--create-home",
		"--skel", "/dev/null", # disable /etc/skel files
		@useradd_opts,
	);

	mkdir(rootconfig($hostname));

	my $uid=int getpwnam($user);
	my $gid=int getgrnam($user);

	# The user needs to own the site lock file, so ikisite
	# processes running as it can do locking.
	chown($uid, $gid, $lockfile)
		|| error "chown $lockfile: $!";

	# create skeleton
	my $home=homedir($hostname);
	mkdir("$home/.ssh") || error "mkdir $home/.ssh: $!";
	mkdir("$home/tmp") || error "mkdir $home/tmp: $!";
	foreach my $file (".ssh", "tmp") {
		chown($uid, $gid, "$home/$file")
			|| error "chown $home/$file: $!";
	}
	chmod(0700, "$home/tmp") || error "chmod $home/tmp: $!";

	my $logdir=logdir($hostname, 1);
	mkdir($logdir) || error "mkdir $logdir: $!";
	writefile("ikisite.log", $logdir, "");
	foreach my $file (".", "ikisite.log") {
		chown(0, $gid, "$logdir/$file")
			|| error "chown $logdir/$file: $!";
	}
	chmod(0750, "$logdir") || error "chmod $logdir: $!";

	my $cgidir=cgidir($hostname, 1);
	mkdir($cgidir) || error "mkdir $cgidir: $!";
	chown($uid, $gid, "$cgidir") || error "chown $cgidir: $!";
	chmod(0755, "$cgidir") || error "chmod $cgidir: $!";

	# configure default username and email for git commits
	runas(username($hostname), sub {
		# we need to move to a directory we can edit
		chdir($home) || error "chdir $home: $!";
		shell(qw{git config --global user.name admin});
		shell(qw{git config --global user.email}, $config{adminemail});
		chmod(0600, "$home/.gitconfig") || error "chmod $home/.gitconfig: $!";
	});
}

sub meta_userdelete {
	required => [qw{hostname}],
	options => [qw{}],
	description => "removes the unix user for a site",
	section => "utility",
}
sub userdelete {
	my $hostname=lc(shift);
	
	assert_root();
	my $lockfile=locksite($hostname);
	assert_wrapper_denied();
	
	shell("rm", "-rf", logdir($hostname));
	shell("rm", "-rf", cgidir($hostname));

	my $user=username($hostname);
	my $status=shell_exitcode("userdel", "-rf", $user);
	# userdel -f returns exit code 12 if it cannot delete the mail
	# spool, which typically will not exist. Work around this bug.
	if ($status != 0 && ($status >> 8) != 12) {
		error("userdel failed");
	}

	shell("rm", "-rf", rootconfig($hostname));
	unlink($lockfile);
}

sub get_apache_conf_tmpl {
	my $hostname = shift;
	my $suffix = shift;
	my $apache_template_vars = shift;

	if (-f rootconfig($hostname)."/apache$suffix.conf.tmpl") {
		my @bits=stat(_);
		if ($bits[4] == 0 && $bits[5] == 0) {
			require HTML::Template;
			my $template=HTML::Template->new(
				filename => rootconfig($hostname)."/apache$suffix.conf.tmpl",
				die_on_bad_params => 0,
			);
			$template->param(@$apache_template_vars);
			return $template->output;
		}
		else {
			print STDERR "warning: ignoring apache$suffix.conf.tmpl; not owned by root\n";
		}
	}

	return "";
}

sub meta_enable {
	required => [qw{hostname}],
	options => [qw{}],
	description => "enables user access to a site",
	section => "utility",
}
sub enable {
	my $hostname=lc(shift);
	
	assert_root();
	locksite($hostname);
	assert_wrapper_denied();

	my $user=username($hostname);
	my $home=homedir($hostname);

	my @hostnames=map { $_->host } urllist($user);
	
	# Lock down the public_html directory so only the site user and
	# www-data can access it.
	my $uid=int getpwnam($user);
	my $www_data_gid=int getgrnam("www-data");
	chown($uid, $www_data_gid, "$home/public_html") || error "chown $home/public_html: $!";
	chmod(0750, "$home/public_html") || error "chmod $home/public_html: $!";

	my $vcs=getsetup($hostname, "rcs");
	if ($vcs eq "git") {
		# Setup git-daemon.
		foreach my $h (@hostnames) {
			my $dest="$config{gitdaemondir}/$h.git";
			unlink($dest);
			# The symlink is always made, but git-daemon will only
			# serve the site if its repository contains
			# git-daemon-export-ok.
			symlink(repository($hostname), $dest);
		}
		# Allow git-daemon to read and write to the repo via ACL.
		readconfig();
		eval { shell("setfacl", "-R", "-m", "d:g:$config{gitdaemonuser}:rwX,d:g:$user:rwX,g:$config{gitdaemonuser}:rwX,g:$user:rwX", "$home/source.git") };
		if ($@) {
			print STDERR "warning: setfacl failed, anonpush will not work (perhaps the filesystem is not mounted with option 'acl'?)\n";
		}
		# Create file if site currently allows branching.
		# The branchable plugin will also create/remove it
		# as needed when the setting is changed.
		my $branchable=getsetup($hostname, "branchable");
		my $flagfile=repository($hostname)."/git-daemon-export-ok";
		if ($branchable) {
			open(FLAG, ">", $flagfile);
			close FLAG;
			shell("chown", "$user:$user", $flagfile);
			chmod(02755, "$home/source.git") || error "chmod $home/source.git: $!";
		}
		else {
			unlink($flagfile);
			chmod(02750, "$home/source.git") || error "chmod $home/source.git: $!";
		}

		# Setup gitweb.
		# An environment variable to points gitweb to
		# this file. We make it a symlink pointing at the real 
		# file, and only enable the link for branchable sites.
		my $gitweb_conf_file=srcdir($hostname)."/.ikiwiki/gitweb.conf";

		# To avoid privilege escalation via gitweb.conf, we run gitweb
		# via a suexec'able CGI script.
		my $cgidir=cgidir($hostname);
		my $gitweb = "$cgidir/gitweb.cgi";
		my $uid=int getpwnam($user);
		my $gid=int getgrnam($user);
		open(GITWEB, ">", "$gitweb") || die "open $gitweb: $!";
		print GITWEB "#!/bin/sh\n";
		print GITWEB "GITWEB_CONFIG=$gitweb_conf_file\n";
		print GITWEB "export GITWEB_CONFIG\n";
		print GITWEB "exec /usr/lib/cgi-bin/gitweb.cgi \"\$@\"\n";
		close GITWEB;
		chown($uid, $gid, $gitweb) || error "chown $gitweb: $!";
		chmod(0755, $gitweb) || error "chmod $gitweb: $!";

		my $gitweb_projectslist=srcdir($hostname)."/.ikiwiki/gitweb-projectslist";
		my $git_description=repository($hostname)."/description";
		outtemplate("$gitweb_conf_file.real", "gitweb.conf.tmpl",
			user => $user,
			home => $home,
			destdir => destdir($hostname),
			cgidir => cgidir($hostname),
			logdir => logdir($hostname),
			hostname => $hostname,
			projectslist => $gitweb_projectslist,
		);
		shell("chown", "$user:$user", "$gitweb_conf_file.real");
		if ($branchable) {
			unlink($gitweb_conf_file); # force refresh symlink
			symlink("$gitweb_conf_file.real", $gitweb_conf_file);
		}
		else {
			unlink($gitweb_conf_file);
		}
		open(DESC, ">", $git_description) || die "$git_description: $!";
		print DESC "source repository for $hostname\n";
		close DESC;
		shell("chown", "$user:$user", $git_description);
		open(PLIST, ">", $gitweb_projectslist) || die "$gitweb_projectslist: $!";
		print PLIST "source.git source\n";
		close PLIST;
		shell("chown", "$user:$user", $gitweb_projectslist);
	}
	
	# Get the url from the setup file. The hostname in this url
	# may be different from the internal site hostname; configure
	# apache to serve the url's hostname.
	eval q{use URI};
	error $@ if $@;
	# ensure url has a trailing slash (apache requires it)
	my $u=getsetup($hostname, "url")."/";
	$u=~s://$:/:;
	my $url=URI->new($u);
	
	my $ssl_cert_file=rootconfig($hostname)."/ssl.crt";
	my $ssl_key_file=rootconfig($hostname)."/ssl.key";
	my $ssl_chain_file=rootconfig($hostname)."/ssl.chain";
	# Check that any user provided key file is not password protected,
	# as that makes apache startup hang. (Also checks that it's valid.)
	if (-e $ssl_key_file) {
		if (shell_exitcode("openssl", "rsa",
				"-in" => $ssl_key_file,
				"-out" => $ssl_key_file, 
				"-passin" => "pass:dummy",
				"-passout" => "pass:dummy") != 0) {
			$ssl_key_file='';
			$ssl_cert_file='';
			$ssl_chain_file='';
		}
	}
	# Use wildcard cert if there is no site specific one, only
	# if the site is not using its own domain name.
	if (defined $config{wildcard_ssl_cert} && length $config{wildcard_ssl_cert} &&
	    defined $config{wildcard_ssl_key} && length $config{wildcard_ssl_key} &&
	    ! -e $ssl_cert_file && ! -e $ssl_key_file) {
		my @domains = split(' ', $config{domains});
		my $wildcard_ok=1;
		foreach my $h (@hostnames) {
			my $w_ok=0;
			foreach my $d (@domains) {
				if ($h =~ /^.+\.\Q$d\E$/i || $h eq $d) {
					$w_ok=1;
				}
			}
			$wildcard_ok = $wildcard_ok && $w_ok;
		}
		if ($wildcard_ok) {
			$ssl_cert_file=$config{wildcard_ssl_cert};
			$ssl_key_file=$config{wildcard_ssl_key};
			if (defined $config{wildcard_ssl_chain} && length $config{wildcard_ssl_chain}) {
				$ssl_chain_file=$config{wildcard_ssl_chain};
			}
			else {
				$ssl_chain_file='';
			}
		}
	}
	my $ssl_enabled=-e $ssl_key_file && -e $ssl_cert_file;
	my @ssl_template_vars=(
		ssl_cert_file => $ssl_cert_file,
		ssl_key_file => $ssl_key_file,
		ssl_enabled => $ssl_enabled,
	);
	if (-e $ssl_chain_file) {
		push @ssl_template_vars, (
			ssl_chain_file => $ssl_chain_file,
			ssl_chain => 1,
		);
	}

	# This is the url that alias urls redirect to.
	my $redirurl=$url;
	my $httpsredirurl=$url->clone;
	if ($ssl_enabled) {
		$httpsredirurl->scheme("https");
		if (getsetup($hostname, 'redirect_to_https')) {
			$redirurl->scheme("https");
			push @ssl_template_vars, (redirect_to_https => 1);
		}
	}

	# generate apache config file
	my @apache_template_vars=(
		suexec => (cgidir($hostname) =~ m!^/var/www!),
		user => $user,
		hostname => $url->host,
		home => homedir($hostname),
		destdir => destdir($hostname),
		cgidir => cgidir($hostname),
		logdir => logdir($hostname),
		source_hostname => "source.$hostname",
		# Value escaped to prevent leakage
		# into RewriteEngine regexp.
		url_escaped => quotemeta($redirurl),
		https_url_escaped => quotemeta($httpsredirurl),
		@ssl_template_vars
	);

	# write and enable apache config file
	my $apache_site="ikisite-".$url->host;
	my $apache_conf_file="/etc/apache2/sites-available/$apache_site.conf";
	outtemplate($apache_conf_file, "apache-site.tmpl",
		@apache_template_vars,
		# If an apache.conf.tmpl is available,
		# it will be added into the apache config file in the default
		# and SSL vhosts.
		apache_conf_tmpl => get_apache_conf_tmpl($hostname, "", [@apache_template_vars]),
		# Similarly, apache-source.conf.tmpl will be added to the
		# source.foo.example.com vhost, and apache-ssl.conf.tmpl
		# to the SSL vhost (only).
		apache_source_conf_tmpl => get_apache_conf_tmpl($hostname, '-source', [@apache_template_vars]),
		apache_ssl_conf_tmpl => get_apache_conf_tmpl($hostname, '-ssl', [@apache_template_vars]),
	);
	my %setup;
	$setup{$url->host}=1;
	if (apache_before_2_4()) {
		shell("a2ensite", "$apache_site.conf");
	}
	else {
		shell("a2ensite", $apache_site);
	}

	# generate apache config files for alias urls, that redirect to the
	# main url
	foreach my $alias (@hostnames) {
		next if $setup{$alias};
		$setup{$alias}=1;
		$apache_site="ikisite-$alias";
		$apache_conf_file="/etc/apache2/sites-available/$apache_site.conf";
		outtemplate($apache_conf_file, "apache-sitealias.tmpl",
			suexec => (cgidir($hostname) =~ m!^/var/www!),
			user => $user,
			hostname => $url->host,
			home => homedir($hostname),
			destdir => destdir($hostname),
			cgidir => cgidir($hostname),
			logdir => logdir($hostname),
			alias => $alias,
			# Value escaped to prevent leakage
			# into RewriteEngine regexp.
			url_escaped => quotemeta($redirurl),
			https_url_escaped => quotemeta($httpsredirurl),
			@ssl_template_vars
		);
		if (apache_before_2_4()) {
			shell("a2ensite", "$apache_site.conf");
		}
		else {
			shell("a2ensite", $apache_site);
		}
	}

	# reload apache config
	eval { shell("apache2ctl", "graceful") };
	if ($@) {
		# avoid leaving apache in a broken state
		foreach my $site (keys %setup) {
			if (apache_before_2_4()) {
				shell("a2dissite", "$site.conf");
			}
			else {
				shell("a2dissite", $site);
			}
		}

		shell("apache2ctl", "graceful");
		error "apache2ctl graceful failed";
	}
	
	enabledns($hostname);

	return 1;
}

sub meta_disable {
	required => [qw{hostname}],
	options => [qw{temporary!}],
	description => "disables user access to a site, without removing it",
	section => "utility",
}
sub disable {
	my $hostname=lc(shift);
	my %options=@_;

	assert_root();
	locksite($hostname);
	assert_wrapper_denied();

	disabledns($hostname) unless $options{temporary};

	my @urls=urllist(username($hostname));

	my $vcs=getsetup($hostname, "rcs");
	if ($vcs eq "git") {
		foreach my $h (map { $_->host } @urls) {
			unlink("$config{gitdaemondir}/$h.git");
		}
	}
	
	# remove apache config file(s)
	my $reload=0;
	foreach my $url (@urls) {
		my $apache_site="ikisite-".$url->host;
		my $apache_conf_file="/etc/apache2/sites-available/$apache_site.conf";
		if (-e $apache_conf_file) {
			# inside guard because a2dissite fails if the config
			# file does not exist, and this needs to be idempotent
			if (apache_before_2_4()) {
				shell("a2dissite", "$apache_site.conf");
			}
			else {
				shell("a2dissite", $apache_site);
			}
			unlink($apache_conf_file);
			$reload=1;
		}
		# If we're now using Apache 2.4, there might be old versions
		# from Apache 2.2 still lying around
		foreach my $detritus (
			"/etc/apache2/sites-enabled/$apache_site",
			"/etc/apache2/sites-available/$apache_site") {
			unlink $detritus || error("unlink $detritus: $!");
			$reload=1;
		}
	}
	shell("apache2ctl", "graceful") if $reload && ! $options{temporary};

	return 1;
}

sub meta_enabledns {
	required => [qw{hostname}],
	options => [qw{}],
	description => "adds a hostname to DNS",
	section => "utility",
}
sub enabledns {
	my $hostname=lc(shift);
	
	assert_root();
	# Enabling dns is a fairly safe operation, and sites need to be
	# able to call it when ipv6_disabled is changed.
	assert_wrapper_unsafe();

	locksite($hostname);

	if ($config{allow_ipv4} || $config{allow_ipv6}) {
		my @commands;
		# A site's setup file can be used to disable ipv6.
		# But, the setup file may not yet exist, if an early dns
		# setup is being done. In that case, ipv6 is assumed not
		# to be disabled, and enabledns is expected to be run
		# a second time once the setup file is in place, and
		# can disable it then.
		my $ipv6_disabled = eval { getsetup($hostname, "ipv6_disabled") };

		my ($ipv4, $ipv6)=site_addresses();
		foreach my $h ($hostname, "source.$hostname") {
			if ($ipv6_disabled || ! defined $ipv6 || ! $config{allow_ipv6}) {
				push @commands, "update delete $h AAAA";
			}
			else {
				push @commands, "update add $h $config{ttl} IN AAAA $ipv6";
			}
			push @commands, "update add $h $config{ttl} IN A $ipv4"
				if defined $ipv4 && $config{allow_ipv4};
		}
		if (! @commands) {
			error("failed to determine IP address");
		}
		nsupdate(@commands);
	}
}

sub meta_disabledns {
	required => [qw{hostname}],
	options => [qw{}],
	description => "removes a hostname from DNS",
	section => "utility",
}
sub disabledns {
	my $hostname=lc(shift);

	assert_root();
	locksite($hostname);
	assert_wrapper_denied();

	if ($config{allow_ipv4} || $config{allow_ipv6}) {
		nsupdate(
			"update delete $hostname",
			"update delete source.$hostname",
		);
	}
}

sub meta_ikiwikisetup {
	required => [qw{hostname}],
	options => [qw{refresh! wrappers!}],
	description => "calls ikiwiki to setup a site",
	section => "utility",
}
sub ikiwikisetup {
	my $hostname=lc(shift);
	my %options=@_;
	
	locksite($hostname);
	assert_wrapper_denied();

	runas(username($hostname), sub {
		my $home=homedir($hostname);
		chdir($home) || error "chdir $home: $!";
		my $setupfile="$home/ikiwiki.setup";
		shell("ikiwiki", "-setup", $setupfile,
			($options{refresh} ? "-refresh" : ()),
			($options{wrappers} ? "-wrappers" : ()));
	});
}

sub meta_ikiwikiclean {
	required => [qw{hostname}],
	options => [qw{}],
	description => "removes ikiwiki generated files",
	section => "utility",
}
sub ikiwikiclean {
	my $hostname=lc(shift);
	
	locksite($hostname);
	assert_wrapper_denied();

	remove_wikilist($hostname);
	runas(username($hostname), sub {
		my $home=homedir($hostname);
		chdir($home) || error "chdir $home: $!";
		my $setupfile="$home/ikiwiki.setup";
		shell("ikiwiki", "-setup", $setupfile, "-clean");

		return 1;
	});
}

sub meta_createsetupbranch {
	required => [qw{hostname}],
	options => [qw{}],
	description => "creates \"setup\" branch in VCS",
	section => "utility",
}
sub createsetupbranch {
	my $hostname=lc(shift);
	
	locksite($hostname);
	assert_wrapper_denied();

	runas(username($hostname), sub {
		chdir(homedir($hostname)) || error "chdir HOME: $!";

		my $vcs=getsetup($hostname, "rcs");

		my @ignores=(
			".ikiwiki",
			"public_html",
			"source",
			"source.".$vcs,
			"logs",
			".ikisite-nonce",
		);
	
		if ($vcs eq "git") {
			push @ignores, ".gitconfig";
			if (-d ".git") {
				error ".git directory already exists";
			}
			shell("git", "init");
			chmod(0700, ".git") || error "chmod .git: $!";
			# convince git to start committing to setup branch
			writefile(".git/HEAD", ".", "ref: refs/heads/setup\n");
			writefile(".gitignore", ".", join("\n", @ignores)."\n");
			chmod(0600, ".gitignore") || error "chmod .gitignore: $!";
			shell("git", "remote", "add", "origin", repository($hostname));
	
			commitsetup($hostname, message => "initial commit of setup files");
	
		}
		else {
			error "createsetupbranch not implemented for $vcs";
		}

		return 1;
	});
}

sub meta_commitsetup {
	required => [qw{hostname}],
	options => [qw{message=s}],
	description => "commits to \"setup\" branch in VCS",
	section => "utility",
}
sub commitsetup {
	my $hostname=lc(shift);
	my %options=@_;
	
	locksite($hostname);
	assert_wrapper_denied();

	runas(username($hostname), sub {
		chdir(homedir($hostname)) || error "chdir HOME: $!";
	
		my $vcs=getsetup($hostname, "rcs");

		my @files=(
			"ikiwiki.setup",
			".ssh/authorized_keys",
			"apache.conf.tmpl", 
		);
		
		my $message=$options{message} ? $options{message} : "commit of setup files";

		if ($vcs eq "git") {
			push @files, ".gitignore";
	
			foreach my $file (@files) {
				if (-e $file) {
					shell("git", "add", $file);
				}
				else {
					# the file may have never been added,
					# so --ignore-unmatch
					shell("git", "rm", "--ignore-unmatch", $file);
				}
			}
			my $changed=`git status --porcelain | grep -v '^\?\?'`;
			if (length $changed) {
				shell("git", "commit", "-m", $message);
				shell("git", "push", "origin", "setup");
			}
		}
		else {
			error "commitsetup not implemented for $vcs";
		}
	
		return 1;
	});
}

sub meta_observe {
	required => [qw{hostname}],
	options => [qw{force!}],
	description => "informs observersites about site creation or removal",
	section => "utility",
}
sub observe {
	my $hostname=lc(shift);
	my %options=@_;

	assert_wrapper_denied();

	readconfig();
	return unless defined $config{observersites};
	my $exists=siteexists($hostname);
	foreach my $observer (split(' ', $config{observersites})) {
		next if $observer eq $hostname;
		next unless siteexists($observer);
		
		runas(username($observer), sub {
			# Load observer site's ikiwiki setup file,
			# and plugins, so rcs_* functions can be used.
			require IkiWiki::Setup;
			%config=(%config, IkiWiki::defaultconfig());
			# Note use of safe mode to avoid running perl 
			# format setup files.
			IkiWiki::Setup::load(homedir($observer)."/ikiwiki.setup", 1);
			IkiWiki::loadplugins();
			IkiWiki::checkconfig();

			chdir(srcdir($observer));
			my $templatefile="templates/observersite.tmpl";
			return unless -e $templatefile;

			my $e="existing/$hostname";
			my $r="removed/$hostname";
			my $page=$exists ? $e : $r;
			my $other=$exists ? $r : $e;
			my $staged=0;
			
			# Handle moving page if it already existed.
			if (-e $other.".mdwn") {
				IkiWiki::rcs_rename($other.".mdwn", $page.".mdwn");
				$staged=1;
				# reset timestamp
				system("touch", $page.".mdwn");
				# just in case $other was not checked into
				# git, remove it
				unlink($other.".mdwn");
			}
			# Handle moving any subpages.
			if (-d $other) {
				IkiWiki::rcs_rename($other, $page);
				$staged=1;
			}

			# Ensure page exists, but avoid destructive
			# overwrites, unless in force mode.
			if (! -e $page.".mdwn" || $options{force}) {
				eval q{use HTML::Template};
				error $@ if $@;
				my $template=HTML::Template->new(
					filename => $templatefile,
				);
				$template->param(hostname => $hostname);
				writefile($page.".mdwn", srcdir($observer), $template->output);
				IkiWiki::rcs_add($page.".mdwn");
				$staged=1;
			}

			if ($staged) {
				IkiWiki::rcs_commit_staged(
					message => "automatic update",
				);
			}
		});
	}
}

sub meta_updatecustomersite {
	required => [qw{hostname}],
	options => [],
	description => "updates customersite checkout",
	section => "utility",
}
sub updatecustomersite {
	my $hostname=lc(shift);
	
	locksite($hostname);
	assert_wrapper_unsafe();

	runas(username($hostname), sub {
		eval q{use IkiWiki::Customer};
		if (! defined IkiWiki::Customer::basedir(1)) {
			error "no customersite checked out; cannot update";
		}
		if (! IkiWiki::Customer::update()) {
			error "update failed";
		}
		return 1;
	});
}

sub meta_add_wikilist {
	required => [qw{hostname}],
	options => [],
	description => "adds hostname's user to /etc/ikiwiki/wikilist",
	section => "utility",
}
sub add_wikilist {
	my $hostname=lc(shift);
	ikiwiki_update_wikilist($hostname, 0);
}

sub meta_remove_wikilist {
	required => [qw{hostname}],
	options => [],
	description => "removes hostname's user to /etc/ikiwiki/wikilist",
	section => "utility",
}
sub remove_wikilist {
	my $hostname=lc(shift);
	ikiwiki_update_wikilist($hostname, 1);
}

sub ikiwiki_update_wikilist {
	my $hostname=lc(shift);
	my $remove=shift;

	assert_root();
	assert_siteexists($hostname, 1);
	
	my $username=username($hostname);

	my $wikilist="/etc/ikiwiki/wikilist";
	if (! -e $wikilist) {
		print "$wikilist does not exist\n";
		return;
	}

	my $changed=0;
	my $seen=0;
	my @lines;
	open (my $list, "<$wikilist") || die "read $wikilist: $!";
	while (<$list>) {
		chomp;
		if (/^\s*([^\s]+)\s*$/) {
			my $user=$1;
			if ($user eq $username) {
				if (! $remove) {
					$seen=1;
					push @lines, $_;
				}
				else {
					$changed=1;
				}
			}
			else {
				push @lines, $_;
			}
		}
		else {
			push @lines, $_;
		}
	}
	if (! $seen && ! $remove) {
		push @lines, $username;
		$changed=1;
	}
	if ($changed) {
		close $list || die "error reading $list: $!\n";
		open ($list, ">$wikilist") || die "cannot write to $wikilist\n";
		foreach (@lines) {
			print $list "$_\n";
		}
		close $list || die "error writing $wikilist: $!\n";
	}

	return 1;
}

sub meta_sshkeys {
	required => [qw{hostname}],
	options => [qw{}],
	description => "lists enabled ssh keys",
	section => "query",
}
sub sshkeys {
	my $hostname=lc(shift);
	
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();
	
	my @ret;
	my $user=username($hostname);
	my $sshdir=homedir($hostname)."/.ssh";
	my $authorized_keys=$sshdir."/authorized_keys";
	if (! -e $authorized_keys) {
		return ();
	}
	open(IN, "<", $authorized_keys) || error("open $authorized_keys: $!");
	while (<IN>) {
		chomp;
		my $k=parse_sshkey($_);
		if (defined $k) {
			push @ret, $k;
		}
	}
	close IN;

	return @ret;
}

sub meta_enablesshkey {
	required => [qw{hostname}],
	options => [qw{key=s}],
	description => "adds the specified ssh key to .ssh/authorized_keys",
	section => "utility",
}
sub enablesshkey {
	my $hostname=lc(shift);
	my %options=@_;
	
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	if (! exists $options{key}) {
		error("must specify a key with --key=");
	}
	my $key=parse_sshkey($options{key});
	if (! defined $key) {
		error "invalid or unsupported ssh key";
	}

	my $user=username($hostname);
	my $sshdir=homedir($hostname)."/.ssh";
	my $authorized_keys=$sshdir."/authorized_keys";
	if (! -d $sshdir) {
		shell("mkdir", "-p", $sshdir);
		shell("chown", "$user:$user", $sshdir);
	}

	# regenerate file, adding key if it is not already present
	my %seen;
	$seen{$key}=1;
	if (-e $authorized_keys) {
		open(IN, "<", $authorized_keys) || error("open $authorized_keys: $!");
		while (<IN>) {
			chomp;
			my $k=parse_sshkey($_);
			$seen{$k}=1 if defined $k;
		}
		close IN;
	}
	my $vcs=getsetup($hostname, "rcs");
	open(OUT, ">", $authorized_keys.".tmp") || error("open: $authorized_keys.tmp: $!");
	foreach my $key (sort keys %seen) {
		print OUT sshkey_line($key, $vcs);
	}
	close OUT || error("close: $!");
	shell("chmod", "400", $authorized_keys.".tmp");
	shell("chown", "$user:$user", $authorized_keys.".tmp");
	CORE::rename($authorized_keys.".tmp", $authorized_keys) || error("rename; $!");

	return 1;
}

sub meta_disablesshkey {
	required => [qw{hostname}],
	options => [qw{key=s all}],
	description => "removes the specified ssh key (or all keys)",
	section => "utility",
}
sub disablesshkey {
	my $hostname=lc(shift);
	my %options=@_;
	
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	my $key;
	if (exists $options{all}) {
		$key=undef;
	}
	elsif (exists $options{key}) {
		$key=parse_sshkey($options{key});
	}
	else {
		error("must specify --all or a key with --key=");
	}
	
	my $user=username($hostname);
	my $sshdir=homedir($hostname)."/.ssh";
	my $authorized_keys=$sshdir."/authorized_keys";

	return 1 if ! -e $authorized_keys;

	if (! -d $sshdir) {
		shell("mkdir", "-p", $sshdir);
		shell("chown", "$user:$user", $sshdir);
	}

	# regenerate file, removing matching keys
	open(IN, "<", $authorized_keys) || error("open $authorized_keys: $!");
	open(OUT, ">", $authorized_keys.".tmp") || error("open: $authorized_keys.tmp: $!");
	my $vcs=getsetup($hostname, "rcs");
	while (<IN>) {
		chomp;
		my $k=parse_sshkey($_);
		if (defined $k && defined $key && $k ne $key) {
			print OUT sshkey_line($k, $vcs);
		}
	}
	close IN;
	close OUT || error("close: $!");
	shell("chmod", "400", $authorized_keys.".tmp");
	shell("chown", "$user:$user", $authorized_keys.".tmp");
	CORE::rename($authorized_keys.".tmp", $authorized_keys) || error("rename; $!");

	return 1;
}

sub meta_calendar {
	required => [qw{hostname}],
	options => [qw{force! startyear=s endyear=s}],
	description => "runs ikiwiki-calendar if the site has the calendar plugin enabled",
	section => "utility",
}
sub calendar {
	my $hostname=lc(shift);
	my %options=@_;
	
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	if ($options{endyear} && ! $options{startyear}) {
		error "cannot specify endyear without startyear";
	}

	if (plugin_enabled($hostname, "calendar") &&
	    defined getsetup($hostname, "archivebase") &&
	    length getsetup($hostname, "archivebase")) {
		runas(username($hostname), sub {
			shell("ikiwiki-calendar",
				($options{force} ? "-f" : ()),
				homedir($hostname)."/ikiwiki.setup",
				($options{startyear} ? $options{startyear} : ()),
				($options{endyear} ? $options{endyear} : ()),
			);
		});
	}
}

sub meta_checksetup {
	required => [qw{setupref}],
	options => [qw{}],
	description => "checks that the specified ref contains only safe changes to the setup branch",
	section => "utility",
}
sub checksetup {
	my $setupref=shift;
	
	my $hostname=userlookup(user => getpwuid($<));
	if (! defined $hostname) {
		error "unable to determine internal hostname";
	}

	# Make a temporary checkout of the ref.
	my $homedir=homedir($hostname);
	eval q{use File::Temp};
	error $@ if $@;
	my $tmpcheckout=File::Temp::tempdir(CLEANUP => 1, DIR => "$homedir/tmp");
	my $newsetup="$tmpcheckout/ikiwiki.setup";
	my $vcs=getsetup($hostname, "rcs");
	if ($vcs eq "git") {
		# doing a shared clone makes the setupref, which has
		# not landed on any branch, be available for checkout
		shell("git", "clone", "--quiet", "--shared",
			"--no-checkout", repository($hostname), $tmpcheckout);
		chdir($tmpcheckout) || error "chdir $tmpcheckout: $!";
		shell("git", "checkout", "--quiet", $setupref, "-b", "setup");
	}
	else {
		error "checksetup not implemented for $vcs";
	}

	# Only allow changes to ikiwiki.setup.
	my @files=map { chomp; $_ } `git diff --name-only remotes/origin/setup...`;
	chdir($homedir) || error "chdir $tmpcheckout: $!";
	if (grep { $_ ne "ikiwiki.setup" } @files) {
		error "rejecting change to setup branch: modification of files other than ikiwiki.setup is not allowed";
	}

	# Make sure that ikiwiki.setup didn't turn into a symlink or other
	# special file, and was not removed.
	if (-l $newsetup || ! -f $newsetup || ! -e $newsetup) {
		error "rejecting change to setup branch: ikiwiki.setup must remain a regular file";
	}
	# paranoia
	if (-x $newsetup || -X $newsetup) {
		error "rejecting change to setup branch: ikiwiki.setup cannot be executable";
	}

	# Load new and current setup file into temporary hashes.
	my $config_new=eval { loadsetup_safe($newsetup) };
	if ($@ || ! defined $config_new) {
		error "rejecting change to setup branch: failed to parse ikiwiki.setup as YAML formatted file (check syntax)\n$@";
	}
	my $config_old=loadsetup_safe($homedir."/ikiwiki.setup");
	# Compare to see which settings changed.
	eval q{use Data::Compare};
	error $@ if $@;
	my %changed;
	my %changed_plugins;
	foreach my $key (keys %$config_new, keys %$config_old) {
		if (! Compare($config_new->{$key}, $config_old->{$key})) {
			if ($key eq 'add_plugins' || $key eq 'disable_plugins') {
				my %old=map { $_ => 1 } @{$config_old->{$key}};
				my %new=map { $_ => 1 } @{$config_new->{$key}};
				foreach my $k (keys %new, keys %old) {
					if (! Compare($new{$k}, $old{$k})) {
						$changed_plugins{$k}=1;
					}
				}
			}
			else {
				$changed{$key}=1;
			}
		}
	}

	# Check that each setting that changed is one that ikiwiki
	# considers safe. Take into account any overrides configured
	# into the websetup plugin.
	# Also, see if a full rebuild is called for by the changes made.
	my $rebuild_needed=0;
	eval q{use IkiWiki::Setup};
	error $@ if $@;
	# bootstrap enough of ikiwiki to load plugins
	my %oldconfig=%config;
	%config=(%config,IkiWiki::defaultconfig(), %$config_old);
	IkiWiki::checkconfig();
	my @setup=([main => [IkiWiki::getsetup()]], IkiWiki::Setup::getsetup());
	%config=%oldconfig;

	my @unsafe_changes;
	my $websetup_unsafe=getsetup($hostname, "websetup_unsafe");
CHANGE:	foreach my $setting (keys %changed) {
		if (! ref $websetup_unsafe ||
		    ! grep { $_ eq $setting } @$websetup_unsafe) {
			foreach my $pair (@setup) {
				my %setup=@{$pair->[1]};
	
				foreach my $key (keys %setup) {
					if ($key eq $setting) {
						$rebuild_needed=1 unless Compare($setup{$key}->{rebuild}, 0);
						next CHANGE if $setup{$key}->{safe};
					}
				}
			}
		}

		push @unsafe_changes, $setting;
	}
	if (@unsafe_changes) {
		print STDERR "the following settings cannot be changed:\n";
		print STDERR "\t$_\n" foreach @unsafe_changes;
	}
	
	my @unsafe_plugin_changes;
	my $websetup_force_plugins=getsetup($hostname, "websetup_force_plugins");
PCHANGE:
	foreach my $p (keys %changed_plugins) {
		if (! ref $websetup_force_plugins ||
		    ! grep { $_ eq $p } @$websetup_force_plugins) {
			foreach my $pair (@setup) {
				next if $pair->[0] ne $p;
				my %setup=@{$pair->[1]};
				$rebuild_needed=1 unless Compare($setup{plugin}->{rebuild}, 0);
				next PCHANGE if $setup{plugin}->{safe};
			}
		}
		
		push @unsafe_plugin_changes, $p;
	}
	if (@unsafe_plugin_changes) {
		print STDERR "the following plugins cannot be enabled/disabled:\n";
		print STDERR "\t$_\n" foreach @unsafe_plugin_changes;
	}
		
	error "rejecting change to setup branch"
		if @unsafe_changes || @unsafe_plugin_changes;
	
	if (%changed || %changed_plugins) {
		# Check out setup file in toplevel. This is slightly tricky
		# as the commit has not landed in the bare git repo yet --
		# but it is available in the tmpcheckout.
		shell("git", "pull", "-q", $tmpcheckout, "setup");
	
		# Refresh or rebuild site to reflect setup changes.
		print STDERR "Updating site to reflect setup changes...\n";
		shell("ikiwiki", "-setup", "ikiwiki.setup", "-v",
			($rebuild_needed ? ("-rebuild") : ("-refresh", "-wrappers"))
		);
	}

	exit 0;
}

sub meta_sudo {
	required => [qw{hostname ...}],
	options => [],
	description => "runs sudo as site user (example: ikisite sudo \$SITE -- ls -l)",
	section => "utility",
}
sub sudo {
	my $hostname=lc(shift);
	
	assert_root();
	# note: no locksite, as commands that themselves lock may be run inside the sudo
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();
	
	$ENV{HOME}=homedir($hostname);
	chdir($ENV{HOME}) || error "chdir: $!";
	shell("sudo", "-u", username($hostname), (@_ ? @_ : ($ENV{SHELL} || "/bin/sh")));
	return undef; # don't print return code
}

sub meta_analog {
	required => [qw{hostname ...}],
	options => [],
	description => "runs analog, generates report to stdout",
	section => "utility",
}
sub analog {
	my $hostname=lc(shift);
	
	assert_siteexists($hostname, 1);
	assert_wrapper_unsafe();
	if (! $config{allow_analog_reports}) {
		assert_root();
	}
	
	chdir(logdir($hostname)) || die "chdir: $!";
	system("analog", "+CREFREPEXCLUDE http://${hostname}/*", "+a", "+f", "+D", glob("access.log*"), @_);
	return undef; # don't print return code
}

sub meta_logview {
	required => [qw{hostname ...}],
	options => [],
	description => "tail -f of all log files",
	section => "utility",
}
sub logview {
	my $hostname=lc(shift);
	
	assert_root();
	assert_siteexists($hostname, 1);
	assert_wrapper_unsafe();
	
	chdir(logdir($hostname)) || die "chdir: $!";
	system("tail", "-f", glob("*.log"), @_);
	return undef; # don't print return code
}

# Run by iki-git-shell, don't trust inputs or stdio.
sub meta_logs {
	required => [qw{}],
	options => [qw{dump tail}],
	description => "tails or dumps apache access.log for current user's site",
	section => "utility",
}
sub logs {
	my %options=@_;

	assert_wrapper_unsafe();
	
	my $username=(getpwuid($<))[0];
	if (! defined $username || ! length $username) {
		error "unable to determine username";
	}
	chdir(userlogdir($username)) || die "chdir: $!";
	if ($options{dump}) {
		foreach my $n (reverse(1..9)) {
			if (-e "access.log.$n.gz") {
				system("zcat", "access.log.$n.gz");
			}
		}
		foreach my $l ("access.log.0", "access.log") {
			if (-e $l) {
				system("cat", $l);
			}
		}
	}
	else {
		print "Viewing logs.. press ctrl-c to exit.\n\n";
		system("tail", "-f", "access.log");
	}
	return undef; # don't print return code
}

sub meta_createnonce {
	required => [qw{hostname}],
	options => [qw{value=s}],
	description => "returns a nonce for ikisite-wrapper",
	section => "utility",
}
sub createnonce {
	my $hostname=shift;
	my %options=@_;

	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	my $nonce=defined $options{value} ? $options{value} : time().':'.`uuid -v4`;
	chomp $nonce;
	my $noncefile=homedir($hostname)."/.ikisite-nonce";
	open(NONCE, ">>", $noncefile) || die "$noncefile: $!";
	my $username=username($hostname);
	shell("chown", "$username:$username", $noncefile);
	shell("chmod", "600", $noncefile);
	print NONCE "$nonce\n";
	close NONCE;
	return $nonce;
}

sub meta_deletenonce {
	required => [qw{hostname}],
	options => [qw{nonce=s}],
	description => "invalidates the specified nonce",
	section => "utility",
}
sub deletenonce {
	my $hostname=lc(shift);
	my %options=@_;

	assert_root();
	locksite($hostname);
	assert_siteexists($hostname, 1);
	assert_wrapper_safe($hostname);

	if (! defined $options{nonce}) {
		error "--nonce required";
	}

	my $noncefile=homedir($hostname)."/.ikisite-nonce";
	open(NONCE, "<", $noncefile) || die "$noncefile: $!";
	my %nonces;
	while (<NONCE>) {
		chomp;
		$nonces{$_}=1;
	}
	close NONCE;
	delete $nonces{$options{nonce}};
	open(NONCE, ">", $noncefile) || die "$noncefile: $!";
	my $username=username($hostname);
	shell("chown", "$username:$username", $noncefile);
	shell("chmod", "600", $noncefile);
	print NONCE "$_\n" foreach keys %nonces;
	close NONCE;

	return 1;
}

sub meta_checksite {
	required => [qw{hostname}],
	options => [qw{wait hasnonce}],
	description => "checks if site is done being created",
	section => "query",
}
sub checksite {
	my $hostname=lc(shift);
	my %options=@_;
	
	assert_root();
	assert_siteexists($hostname, 1);
	assert_wrapper_unsafe();

	my $checknonce = sub {
		if ($options{hasnonce}) {
			my $noncefile=homedir($hostname)."/.ikisite-nonce";
			if (! -e $noncefile) {
				return IkiWiki::SuccessReason->new("$hostname lacks nonce");
			}
		}
		return IkiWiki::SuccessReason->new("$hostname is ready");
	};

	if ($options{wait}) {
		# blocking wait
		locksite($hostname);
		return $checknonce->();
	}
	else {
		# nonblocking lock test
		my $lockfile="$config{lockdir}/".username($hostname);
		open(CHECKLOCK, '>', $lockfile) ||
			error ("cannot write to $lockfile: $!");
		if (! flock(CHECKLOCK, 2 | 4)) { # LOCK_EX | LOCK_NB
			close CHECKLOCK;
			return IkiWiki::FailReason->new("$hostname is locked");
		}
		else {
			close CHECKLOCK;
			return $checknonce->();
		}
	}
}

sub meta_upgrade {
	required => [qw{hostname}],
	options => [],
	description => "upgrade a site to new layout",
	section => "primary",
}
sub upgrade {
	my $hostname=lc(shift);

	assert_root();
	assert_siteexists($hostname, 1);
	assert_wrapper_denied();

	my $home=homedir($hostname);

	my @cleanup;
		
	my $user=username($hostname);
	my $uid=int getpwnam($user);
	my $gid=int getgrnam($user);

	# logs moved
	if (-d "$home/logs") {
		my $newlogdir=logdir($hostname, 1);
		if (! -d $newlogdir) {
			mkdir($newlogdir) || error "mkdir $newlogdir: $!";
			chmod(0750, "$newlogdir") || error "chmod $newlogdir: $!";
		}
		foreach my $file (<$home/logs/*>) {
			my $basefile=IkiWiki::basename($file);
			my $dest="$newlogdir/$basefile";
			if (! -e $dest) {
				shell("mv", "-f", $file, $dest);
			}
			else {
				print STDERR "warning: $file not moved to $basefile, which already exists\n";
			}
		}
		rmdir("$home/logs");

		# Only ikisite log is writable by the site user's gid.
		foreach my $file (".", "ikisite.log") {
			chown(0, $gid, "$newlogdir/$file")
				|| error "chown $newlogdir/$file: $!";
		}
	}

	# cgi moved, and is no longer suid, as suidexec is used.
	my $oldcgi=$home."/public_html/ikiwiki.cgi";
	if (-e $oldcgi) {
		push @cleanup, $oldcgi;

		my $cgidir=cgidir($hostname, 1);
		mkdir($cgidir) || error "mkdir $cgidir: $!";
		chown($uid, $gid, "$cgidir") || error "chown $cgidir: $!";
		chmod(0755, "$cgidir") || error "chmod $cgidir: $!";

		eval q{use YAML::Syck};
		die $@ if $@;
		readconfig();

		changesetup($hostname,
			rebuild => 0,
			commit => 1,
			message => "ikisite upgrade",
			set => [
				"cgi_wrapper" ."=". $cgidir."/ikiwiki.cgi",
				"cgi_wrappermode" ."=". "0755",
			],
			# gitdaemonuser became an untrusted committer
			'set-yaml' => [
				"untrusted_committers=".Dump([$config{gitdaemonuser}]),
			],
		);

		changesetup($hostname,
			rebuild => 0,
			commit => 1,
			message => "ikisite upgrade",
			set => [
				"cgi_wrapper" ."=". $cgidir."/ikiwiki.cgi",
				"cgi_wrappermode" ."=". "0755",
			],
		);
	}

	# File perms were locked down.
	foreach my $file ("ikiwiki.setup", ".gitconfig", ".gitignore") {
		if (-e "$home/$file") {
			chmod(0600, "$home/$file") || error "chmod $home/$file: $!";
		}
	}
	# Dir perms were locked down.
	foreach my $dir (".git", "source") {
		if (-e "$home/$dir") {
			chmod(0700, "$home/$dir") || error "chmod $home/$dir: $!";
		}
	}
	foreach my $dir ("apache") {
		if (-e "$home/$dir") {
			shell("chown", "$user:www-data", "$home/$dir");
			chmod(0750, "$home/$dir") || error "chmod $home/$dir: $!";
		}
	}

	# New rootconfig directory created.
	my $rootconfig=rootconfig($hostname);
	if (! -d $rootconfig) {
		mkdir($rootconfig) || error "mkdir $rootconfig: $!";
		my $old=homedir($hostname)."/apache.conf.tmpl";
		if (-e $old &&
		    ! -e "$rootconfig/apache.conf.tmpl") {
		    	# Safe because the file will only be used if owned
			# by root.
			shell("mv", "-f", $old, $rootconfig);
		}
	}

	# Disable and re-enable to write new apache configs, etc.
	disable($hostname, temporary => 1);
	enable($hostname);

	foreach my $file (@cleanup) {
		unlink($file) || error "unlink $file: $!";
	}
}

############################################################################

my %locks;
sub locksite {
	my $hostname=shift;

	my $lockfile="$config{lockdir}/".username($hostname);

	if (! exists $locks{$hostname}) {
		open($locks{$hostname}, '>', $lockfile) ||
			error ("cannot write to $lockfile: $!");
		if (! flock($locks{$hostname}, 2)) { # LOCK_EX
			error("flock: $!");
		}
	}

	return $lockfile;
}

sub urllist {
	my $username=shift;

	my @urls;
	my $urlalias=getsetup(undef, "urlalias", user => $username);
	if (ref $urlalias) {
		push @urls, @$urlalias;
	}
	push @urls, getsetup(undef, "url", user => $username);
	eval q{use URI};
	error $@ if $@;
	return grep { $_->can("host") } map { URI->new($_) } @urls;
}

sub githooks {
	my $repository=shift;

	unlink("$repository/hooks/update");
	symlink("/usr/bin/iki-git-hook-update", "$repository/hooks/update") || error("symlink: $!");
}

sub parse_sshkey {
	my $line=shift;
	
	return undef if $line=~/^\s*#/;

	# Parse key out of line, which may be just the key,
	# or may be an authorized_keys line, and may have surrounding whitespace.
	# Retain one word of optional comment part.
	if ($line =~ /^(?:.* )?\s*(ssh-\w+\s+[A-Za-z0-9+\/=]+(?:\s+[^\s]*)?)\s*.*$/) {
		return $1;
	}
	else {
		return undef;
	}
}

sub sshkey_line {
	my $key=shift;
	my $vcs=shift;

	if ($vcs eq 'git') {
		return "command=\"iki-git-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty,no-user-rc $key\n";
	}
	else {
		error("unsupported vcs $vcs");
	}
}

sub assert_siteexists {
	my $hostname=shift;
	my $should=shift;

	my $exists=siteexists($hostname);
	if ($exists != $should) {
		if ($exists) {
			error "$hostname already exists";
		}
		else {
			if (ref($exists) eq 'IkiWiki::FailReason') {
				error "$exists";
			}
			else {
				error "$hostname does not exist";
			}
		}
	}

}

sub assert_wrapper_denied {
	if (exists $ENV{IKISITE_NONCE}) {
		error "subcommand cannot be run via wrapper";
	}
}

sub assert_wrapper_unsafe {
	my $hostname=shift;

	delete $ENV{IKISITE_NONCE};
}

sub assert_wrapper_safe {
	my $hostname=shift;

	# IKISITE_NONCE, if set, must be equal to a line from the
	# .ikisite-nonce file. This allows suid wrappers to pass the
	# variable through to check that their caller knows a valid nonce
	# for the site.
	if (exists $ENV{IKISITE_NONCE}) {
		my $noncefile=homedir($hostname)."/.ikisite-nonce";
		open(NONCE, "<", $noncefile) || die "$noncefile: $!";
		while (<NONCE>) {
			chomp;
			if ($_ eq $ENV{IKISITE_NONCE}) {
				close NONCE;
				delete $ENV{IKISITE_NONCE};
				return 1;
			}
		}
		close NONCE;

		error "nonce check failure";
	}
}

sub isemail {
	my $email=shift;

	return unless defined $email && length $email;

	# This is not intended to be a complete RFC compliant email address
	# check. It only makes sure the email contains only legal
	# characters.
	return $email =~ /[^-+@_.a-zA-Z0-9]/;
}

sub isinternaldomain {
	my $domain=shift;

	while (length $domain) {
		if (defined eval { username($domain) } && !$@) {
			return 1;
		}
		$domain=~s/^[^.]+(\.|$)//; # strip subdomains
	}

	return 0;
}

sub plugin_enabled {
	my $hostname=shift;
	my $plugin=shift;

	my @add_plugins=@{getsetup($hostname, "add_plugins")};
	my @disable_plugins=@{getsetup($hostname, "disable_plugins")};

	return 0 if grep { $_ eq $plugin } @disable_plugins;
	return 1 if grep { $_ eq $plugin } @add_plugins;
	return undef; # might be enabled by default or pulled in via plugin bundle
}

sub actionlog {
	my $message=shift;
	my $subcommand=shift;
	my $hostname=shift; # hostname is always the first required parameter
	return unless defined $hostname && length $hostname;

	my $username=eval { username($hostname) };
	return unless defined $username;

	my $logdir=eval { logdir($hostname) };
	return unless defined $logdir;

	my $localhost=eval q{use Sys::Hostname; hostname()} || "somehost";

	open(LOG, ">>", "$logdir/ikisite.log") || return;
	print LOG gmtime()." $localhost: $subcommand: $message\n";
	close LOG;
}

# used only for recording a few specific actions:
# site creation and deletion
sub accountinglog ($$;$) {
	my $action=shift; # "create" or "delete"
	my $hostname=shift;
	my $username=shift; # only for create

	readconfig();
	open(ACCOUNTING_LOG, ">>", $config{accountinglog}) || error "$config{accountinglog}: $!";
	if ($action eq "create") {
		print ACCOUNTING_LOG gmtime(time)." create $hostname $username\n";
	}
	elsif ($action eq "delete") {
		print ACCOUNTING_LOG gmtime(time)." delete $hostname\n";
	}
	else {
		error "accountinglog: unsupported action $action";
	}
	close ACCOUNTING_LOG;
	
	# Inform observers as background job to avoid delaying eg, 
	# site creation.
	my $pid=IkiWiki::Hosting::daemonize();
	if ($pid) {
		return;
	}
	# Avoid keeping sites locked while daemonized.
	foreach my $site (keys %locks) {
		close($locks{$site});
	}
	# Wait a minute to let anything that is being done settle.
	sleep(60);
	observe($hostname);
	exit;
}

sub nsupdate {
	# chdir done here because nsupdate expects the other key in the pwd
	chdir "$config{keydir}/dns" || error "chdir $config{keydir}/dns: $!";

	my @privkey=glob("K**.private");
	if (! @privkey) {
		error("cannot find private key in $config{keydir}/dns");
	}

	# Any key in the directory is assumed to work, so just take the first.
	debug("nsupdate -k $privkey[0] <<EOF");
	open(NSUPDATE, "|-", "nsupdate", "-k", $privkey[0]) || error("nsupdate: $!");
	print NSUPDATE join("\n", @_)."\n\n";
	debug($_) foreach @_;
	debug("EOF");
	if (! close NSUPDATE) {
		error("nsupdate failed")
	}

	chdir "/";
}

sub loadsetup_safe {
	my $setupfile=shift;

	require IkiWiki::Setup;
	# Avoid polluting our %config with site setup.
	my %ret;
	no warnings;
	my $overridden=\&IkiWiki::Setup::merge;
	*IkiWiki::Setup::merge=sub { %ret=%{shift()} };
	# This can fail with error; catch to clean up.
	eval {
		# Note that safe mode is enabled, to avoid this
		# executing IkiWiki::Setup::Standard setup files.
		IkiWiki::Setup::load($setupfile, 1);
	};
	*IkiWiki::Setup::merge=$overridden;
	use warnings;
	die $@ if $@;

	return \%ret;
}

main(\&actionlog);