#!/usr/bin/perl -w
#
# Copyright (C) 2011,2012,2013,2015,2018,2019 Olly Betts
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.

use strict;
use Fcntl ':flock';
use File::Find;
use File::Path;
use Sys::Hostname;
use POSIX;

my $MAXLOADPERCPU = 1.5;

my $verbose = exists $ENV{VERBOSE};

sub run_command {
    my $cmd = shift;
    my $out = `$cmd`;
    chomp $out;
    return $out;
}

my $force = 0;
if (scalar @ARGV && $ARGV[0] eq '--force') {
    shift @ARGV;
    $force = 1;
}

# Configuration:
my $work = "/home/olly/tmp/xapian-git-snapshot";
# Add ccache's directory first so we'll use it if it is installed.
$ENV{PATH} = "/usr/lib/ccache:/home/olly/install/bin:/usr/bin:/bin";
# Currently $repourl needs to be a filing system path.
my $repourl = '/home/xapian-git-write/xapian';
my $webbase = '/srv/www';

# Create the work directory first, since we need it to exist so we can create
# the lockfile.
mkpath($work, 0, 0755);
chdir $work or die $!;

# Prevent multiple instances of this script from running at once.
# Use the same lockfile that fetch does.
open LOCK, '>', 'flockme' or die "Couldn't open 'flockme' for writing: $!\n";
unless (flock LOCK, LOCK_EX|LOCK_NB) {
    # If we're building a tagged release, we want to wait rather than exit.
    unless (scalar @ARGV && $ARGV[0] =~ m!^tags/! && flock LOCK, LOCK_EX) {
	# Work directory already in use.  Don't print anything unless STDERR
	# is a tty - the cron job will send it as mail, which we don't really
	# want.
	print STDERR "'flockme' is already locked, can't build '$ARGV[0]' right now\n"
	    if -t STDERR;
	exit 1;
    }
}

# Check the load average AFTER getting the lock, since we generate output if
# the load is too high, and it will probably be too high if we're already
# running.
my $HOSTNAME = Sys::Hostname::hostname();
# Check the load average isn't too high.
if (!$force) {
    if (-e "/var/run/dobackup") {
	print STDERR "$HOSTNAME: Backup running (/var/run/dobackup exists)\n"
	    if -t STDERR;
	exit(1);
    }
    if (((`uptime 2>/dev/null`)[0] =~ /.*: (\d+(?:\.\d+)?),/) &&
	($1 > $MAXLOADPERCPU)) {
	my $loadavg = $1;
	# `getconf _NPROCESSORS_ONLN` on linux gives e.g. 2
	# `sysctl hw.ncpu` on openbsd (and prob. freebsd & darwin) gives e.g. hw.ncpu=2
	# `psrinfo|grep -c on-line` on Solaris or OSF/1 gives e.g. 2
	my $ncpu;
	# Works on Linux, at least back to kernel 2.2.26.
	$ncpu ||= run_command("getconf _NPROCESSORS_ONLN 2>/dev/null|grep -v '[^0-9]'");
	# Works on OpenBSD (and apparently FreeBSD and Darwin).
	$ncpu ||= run_command("sysctl hw.ncpu 2>/dev/null|sed 's/.*=//'");
	# Works on Solaris and OSF/1.
	$ncpu ||= run_command("PATH=/usr/sbin:\$PATH psrinfo 2>/dev/null|grep -c on-line");
	# Works on Linux, just in case the getconf version doesn't.  Different
	# architectures have different formats for /proc/cpuinfo so this won't
	# work as widely as getconf _NPROCESSORS_ONLN will.
	$ncpu ||= run_command("grep -c processor /proc/cpuinfo 2>/dev/null");
	$ncpu ||= 1;
	if ($loadavg > $ncpu * $MAXLOADPERCPU) {
	    $ncpu ||= "unknown";
	    print STDERR "$HOSTNAME: High load average: $loadavg ($ncpu CPUs)\n";
	    exit(1);
	}
    }
}

# If tags or branches are specified, default to branches for which there are
# existing directories.
if (scalar @ARGV == 0) {
    sub find_git_refs {
	my $ref = $File::Find::name;
	open CMD, "git -C \Q$repourl\E show --format=oneline --no-patch \Q$ref\E -- 2>/dev/null|" or die $!;
	my $first_line = <CMD>;
	close CMD or return;
	# Valid ref, so don't recurse into it.
	$File::Find::prune = 1;
	# Filter out tags - those generally don't change and we only build them
	# when explicitly listed on the command line.
	if (substr($first_line, 0, 4) ne 'tag ') {
	    push @ARGV, $ref;
	}
    }
    find(\&find_git_refs, glob('[A-Za-z0-9]*'));
}

# Or if there are no directories, default to git master.
if (scalar @ARGV == 0) {
    mkdir 'master';
    @ARGV = 'master';
}

my $status = 0;
foreach my $ref (@ARGV) {
    chdir $work or die $!;
    # Restrict to sane characters.
    next if $ref !~ /^[-A-Za-z0-9_.\/]+$/;
    if (! -d $ref) {
	print "*** No directory for '$ref'\n";
	$status = 1;
	next;
    }

    my $is_tag;
    {
	open CMD, "git -C \Q$repourl\E show --format=oneline --no-patch \Q$ref\E -- 2>/dev/null|" or die $!;
	my $first_line = <CMD>;
	if (!close CMD) {
	    print "*** Not a valid git ref: $ref\n";
	    $status = 1;
	    next;
	}

	$is_tag = (substr($first_line, 0, 4) eq 'tag ');
    }

    my $logfile = "$ref/snapshot.log";
    my $log = '';
    # Check out into a 'xapian' subdirectory of the rev's directory.
    my $co_dir = "$ref/xapian";
    if (! -d "$co_dir/.git") {
	system "chmod", "-R", "+w", $co_dir if -d $co_dir;
	system "rm", "-rf", $co_dir;
	open CMD, "git clone --branch \Q$ref\E \Q$repourl\E \Q$co_dir\E 2>&1|" or die $!;
	$log = join '', <CMD>;
	close CMD or do { print $log; die $!; };
	chdir $co_dir or die $!;
    } else {
        # Revert any local changes.
	chdir $co_dir or die $!;
	$log = "git reset --hard:\n".`git reset --hard 2>&1`."git pull --ff-only:\n";
	open CMD, "git pull --ff-only 2>&1|" or die $!;
	my $changed = 1;
	while (<CMD>) {
	    $log .= $_;
	    if ($changed && !$force) {
		if (/^Already up-to-date/) {
		    $changed = 0;
		}
	    }
	}
	close CMD or die $!;
	if (!$changed) {
	    $verbose and print "No changes\n";
	    next;
	}
    }
    my ($revision) = `git describe --always`;
    chomp($revision);
    my ($revcount) = ($revision =~ /-([0-9]+)-/);
    if (!defined $revcount) {
	# Workaround for branches from before the first git tag - count commits since 1.3.1.
	$revcount = scalar(@{[`git log --format='%H' 1daf0071342d883ca308762f269a63f6ec5df981..`]});
	$revision = "v1.3.1-$revcount-g$revision";
    }

    chdir $work or die $!;

    # Don't repeat a build for the same revision.
    next if -f "$logfile.$revision";

    open LOG, ">", "$logfile.$revision" or die $!;
    # Flush output after every print.
    my $old_fh = select(LOG);
    $| = 1;
    select($old_fh);

    print LOG $log;
    $log = undef;

    if (!$is_tag) {
	# Modify configure.ac files to insert $revision into version string.
	foreach my $configure_ac
	    (glob("\Q$co_dir\E/xapian*/configure.ac"),
	     glob("\Q$co_dir\E/xapian*/*/configure.ac")) {
	    open OUT, ">", "tmp.out" or die $!;
	    open IN, "<", $configure_ac or die $!;
	    while (<IN>) {
		s/(^(?:AC_INIT\([^,]*|m4_define\(\[project_version\]),.*?[0-9])(\s*[),\]])/$1_git$revcount$2/g;
		print OUT;
	    }
	    close IN or die $!;
	    close OUT or die $!;
	    rename "tmp.out", $configure_ac or die $!;
	}
	if (-f  "$co_dir/search-xapian/Makefile.PL") {
	    my $snap_version;
	    my $fnm = "$co_dir/search-xapian/Xapian.pm";
	    open OUT, ">", "tmp.out" or die $!;
	    open IN, "<", $fnm or die $!;
	    while (<IN>) {
		if (s/^(our \$VERSION = ')(\d+\.\d+\.\d+\.)\d+(.*)/$1$2$revcount$3 # git snapshot/) {
		    $snap_version = $2 . $revcount;
		}
		print OUT;
	    }
	    close IN or die $!;
	    close OUT or die $!;
	    rename "tmp.out", $fnm or die $!;

	    $fnm = "$co_dir/search-xapian/README";
	    open OUT, ">", "tmp.out" or die $!;
	    open IN, "<", $fnm or die $!;
	    $_ = <IN>;
	    s/(\d+\.\d+\.\d+\.)\d+/$1$revcount (git snapshot)/;
	    print OUT;
	    while (<IN>) {
		print OUT;
	    }
	    close IN or die $!;
	    close OUT or die $!;
	    rename "tmp.out", $fnm or die $!;

	    $fnm = "$co_dir/search-xapian/Changes";
	    open OUT, ">", "tmp.out" or die $!;
	    open IN, "<", $fnm or die $!;
	    while (<IN>) {
		print OUT;
		last if /^\s*$/;
	    }
	    print OUT $snap_version.strftime("  %a %b %e %H:%M:%S %Z %Y\n",gmtime());
	    print OUT "\t- git snapshot of revision $revision.\n\n";
	    while (<IN>) {
		print OUT;
	    }
	    close IN or die $!;
	    close OUT or die $!;
	    rename "tmp.out", $fnm or die $!;
	}
    }

    system "chmod", "-R", "+w", "$ref/build" if -d "$ref/build";
    system "rm", "-rf", "$ref/build";
    mkpath("$ref/build", 0, 0755) or die $!;
    chdir "$ref/build" or die $!;

    # Note the current time so we can find sources which weren't used during
    # the build.  Sleep for a couple of seconds first to avoid needing to
    # worry about timestamps equal to $timestamp.
    sleep 2;

    # Skip xapian-letor for now, as atreus lacks libsvm-dev, or the ability
    # to install a new enough one from a package.
    open TOUCH, '>>', '../xapian/xapian-letor/.nobootstrap' and close TOUCH;

    open F, '<', '../xapian/bootstrap' or die $!;
    <F>;
    my $timestamp = (stat F)[8];
    close F;

    $log = `../xapian/bootstrap 2>&1`;
    print LOG $log;
    if ($?) {
	print "*** bootstrap failed for '$ref':";
	print $log;
	$status = 1;
	next;
    }
    $log = undef;

    # On the old server, javac kept going into memory eating loops, so we
    # skipped the java bindings.  Reenable for now...
    #$log = `../xapian/configure --enable-quiet --enable-maintainer-mode --without-java 2>&1`;
    $log = `../xapian/configure --enable-quiet --enable-maintainer-mode 2>&1`;
    print LOG $log;
    if ($?) {
	print "*** configure failed for '$ref':";
	print $log;
	$status = 1;
	next;
    }
    $log = undef;

    $log = `make -s 2>&1`;
    print LOG $log;
    if ($?) {
	print "*** make failed for '$ref':";
	print $log;
	$status = 1;
	next;
    }
    $log = undef;

    my %unused_files = ();
    sub check_unused_files_from_build {
	return if $File::Find::name eq '../xapian';
	my $f = substr($File::Find::name, length('../xapian/'));
	if ($_ eq 'autom4te.cache' ||
	    $_ eq 'debian' ||
	    $f eq 'search-xapian/blib' ||
	    $f eq 'swig' ||
	    $f eq 'xapian-applications/omega/common' ||
	    $f eq 'xapian-data' || # FIXME: make check should use this
	    $f eq 'xapian-maintainer-tools' ||
	    $f eq 'BUILD' ||
	    $f eq 'INST' ||
	    $f eq '.git' ||
	    /^Search-Xapian-\d+\.\d+\.\d+\.\d+$/) {
	    if (-d $File::Find::name) {
		# Don't descend into these subdirectories.
		$File::Find::prune = 1;
		return;
	    }
	}
	return unless -f $File::Find::name and (stat _)[8] < $timestamp;
	return if $_ eq '.gitignore';
	return if $_ eq 'config.h.in~';
	return if $_ eq 'NEWS.SKELETON';
	return if $f eq 'README';
	return if $f eq '.appveyor.yml';
	return if $f eq '.github/workflows/ci.yml';
	return if /^Search-Xapian-\d+\.\d+\.\d+\.\d+\.tar\..z$/;
	++$unused_files{$f};
	print "Unused during make: $f\n";
    }
    find(\&check_unused_files_from_build, '../xapian');

    my $lib = (<xapian-core/.libs/libxapian*.so>)[0];
    my $unstripped_so = -s $lib;
    $log = `strip \Q$lib\E`;
    print LOG $log;
    $log = undef;
    my $stripped_so = -s $lib;

    open SIZELOG, ">>/home/olly/xapian-autobuild-stats.log";
    print SIZELOG "$ref\trev=$revision\tunstripped_so=$unstripped_so\tstripped_so=$stripped_so\n";
    close SIZELOG;

    # Be more verbose about test failures.
    $ENV{VERBOSE} = 1;

    # Skip timed tests which can be flaky under variable load.
    $ENV{AUTOMATED_TESTING} = 1;

    # Need to set LD_LIBRARY_PATH so that e.g. omega run from omegatest finds
    # a suitable "libxapian.so".
    $log = `env LD_LIBRARY_PATH="\`pwd\`"/xapian-core/.libs make -s distcheck VALGRIND= 2>&1`;
    print LOG $log;
    if ($?) {
	print "*** make distcheck failed for '$ref':";
	print $log;
	$status = 1;
	next;
    }
    $log = undef;

    # This finds files we don't ship or use to get to what we ship:
    find(\&check_unused_files_from_build, '../xapian');

    my $d = "$webbase/oligarchy.co.uk/xapian/$ref";
    if ($is_tag && $ref =~ m!^v?([\d.]+)$!) {
	$d = "$webbase/oligarchy.co.uk/xapian/$1";
    }
    if (! -d $d) {
	mkpath($d, 0, 0755) or die $!;
	open HTACCESS, ">", "$d/.htaccess" or die $!;
	print HTACCESS "IndexOptions NameWidth=*\n";
	close HTACCESS or die $!;
    } else {
	if (-d "$d/old") {
	    # Delete snapshots more than a week old, but leave at least one.
	    my $num_of_days_to_keep = 7;
	    my @o = glob "$d/old/*.tar.?z";
	    my $n = scalar @o;
	    @o = grep {-M $_ > $num_of_days_to_keep} @o;
	    $n -= scalar @o;
	    unlink @o if $n > 0;
	} else {
	    mkdir "$d/old", 0755 or die $!;
	    open HTACCESS, ">", "$d/old/.htaccess" or die $!;
	    print HTACCESS "IndexOptions NameWidth=*\n";
	    close HTACCESS or die $!;
	}
	for (glob "$d/*.tar.?z") {
	    my ($leaf) = m!([^/]*)$!;
	    rename $_, "$d/old/$leaf";
	}
    }
    for (glob("*/*.tar.?z"), glob("xapian-applications/*/*.tar.?z"), glob("*.tar.?z")) {
	print LOG "Moving '$_' to '$d'\n";
	system("mv", $_, $d);
	if ($?) {
	    print LOG "Failed with exit code $?\n";
	} else {
	    print LOG "OK\n";
	}
    }
    for (glob("search-xapian/*.tar.?z")) {
	print LOG2 "Moving '$_' to '$d'\n";
	system("mv", $_, $d);
	if ($?) {
	    print LOG2 "Failed with exit code $?\n";
	} else {
	    print LOG2 "OK\n";
	}
    }
    chdir("..");
    system("rm -rf xapian/search-xapian/Search-Xapian-*");
    close LOG;
    # Expire logs more than 10 days old
    unlink grep {-M $_ > 10} glob 'snapshot.log.*';
}

system("/home/olly/bin/plot-sizes");
exit($status);
