#!/usr/bin/env perl
# Start the whole demo: two instrumented services, one receiver, and traffic.
#
#   ./bin/demo              start everything, seed, then run live traffic
#   ./bin/demo --no-traffic start everything and stop
#   ./bin/demo --seconds 90 how long the live traffic runs
#
# Everything runs on localhost and nothing is installed. Ctrl-C stops it all.
use 5.010;
use strict;
use warnings;

# UNBUFFERED, because this script's output is a running commentary on what it
# started and half of it is worthless arriving late. Redirected to a file it
# is block-buffered, so `./bin/demo > log` showed the servers coming up and
# then nothing until the process was killed.
$| = 1;
use FindBin ();
use File::Path ();
use Getopt::Long ();
use POSIX ();

my $HERE = $FindBin::Bin;
my $EXAMPLE = "$HERE/..";       # the example directory
my $ROOT    = "$HERE/../..";    # the Punk-Observe checkout

my %PORT = (observe => 5001, cards => 5002, shop => 5000);

# HYPERMAN, NOT PLACKUP'S DEFAULT SERVER.
#
# HTTP::Server::PSGI serves one connection at a time. With keep-alive clients
# and a dependency that takes three seconds, that means the shop stops
# answering entirely during the incident and the receiver stops accepting
# telemetry - so the demo shows a dead server rather than a slow one, which is
# the wrong lesson and not what the code does.
#
# Hyperman is the event loop Punk is built for and the one this whole
# distribution is designed around. Fall back if it is not installed, and say
# so, because the demo still works and only looks worse.
my $SERVER = eval { require Plack::Handler::Hyperman; 1 } ? 'Hyperman' : 'Standalone';
my ($seconds, $traffic, $keep, $WORKERS) = (120, 1, 0, 4);
Getopt::Long::GetOptions(
    'seconds=i' => \$seconds,
    'traffic!'  => \$traffic,
    'keep'      => \$keep,
    'workers=i' => \$WORKERS,
) or die "usage: $0 [--seconds N] [--no-traffic] [--keep] [--workers N]\n";

# The dist's own blib, plus its siblings. A demo inside a checkout runs
# against THAT checkout, not against whatever is installed - otherwise it
# demonstrates the wrong version and says nothing about the code in front of
# you.
my @INC_ARGS = map { ("-I", $_) } grep { -d $_ } (
    "$ROOT/blib/lib", "$ROOT/blib/arch",
    "$ROOT/../Punk-OpenTelemetry/blib/lib",
    "$ROOT/../Punk-OpenTelemetry/blib/arch",
);

my $STORE = "$EXAMPLE/var/store";
File::Path::remove_tree($STORE) if -d $STORE && !$keep;
File::Path::make_path($STORE);

# ---------------------------------------------------------------------------

my @kids;
sub spawn {
    my ($name, $dir, $port, %env) = @_;
    my $pid = fork();
    die "fork: $!" unless defined $pid;
    if ($pid == 0) {
        %ENV = (%ENV, %env);
        chdir "$EXAMPLE/$dir" or die "chdir $dir: $!";
        open STDOUT, '>>', "$EXAMPLE/var/$name.log" or die $!;
        open STDERR, '>&', \*STDOUT or die $!;
        $| = 1;
        exec $^X, @INC_ARGS, "-I", "lib", scalar(_plackup()),
             '-s', $SERVER, '--port', $port, '--app', 'app.psgi',
             # A REAL POOL. Every worker writes its own write-ahead log and
             # the read side merges them, which is the whole storage design in
             # miniature - and running one worker to make the numbers add up
             # would have hidden it.
             ($SERVER eq 'Hyperman' ? ('--workers', $WORKERS) : ())
            or die "exec: $!";
    }
    push @kids, [ $name, $pid, $port ];
    return $pid;
}

sub _plackup {
    for my $p (split /:/, $ENV{PATH}) {
        return "$p/plackup" if -x "$p/plackup";
    }
    die "plackup not found in PATH\n";
}

sub shutdown_all {
    for my $k (reverse @kids) {
        kill 'TERM', $k->[1];
    }
    for my $k (@kids) { waitpid $k->[1], 0 }
    @kids = ();
}
$SIG{INT} = $SIG{TERM} = sub { print "\nstopping\n"; shutdown_all(); exit 0 };

# Wait for a port to answer rather than sleeping a guessed amount. A fixed
# sleep is a coin toss on a loaded machine.
# punk-queue, found the way plackup is: the script that belongs to THIS perl,
# not whichever one is first on PATH. The demo runs under a perl that has the
# Punk family installed and the system one does not.
sub _punk_queue {
    require Config;
    my $s = "$Config::Config{scriptdir}/punk-queue";
    return $s if -x $s;
    for my $d (split /:/, ($ENV{PATH} || '')) {
        return "$d/punk-queue" if -x "$d/punk-queue";
    }
    die "punk-queue not found - install Punk::Queue\n";
}

sub wait_for {
    my ($port, $what) = @_;
    require IO::Socket::INET;
    for (1 .. 200) {
        my $s = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port,
                                      Proto => 'tcp', Timeout => 1);
        if ($s) { close $s; return 1 }
        select undef, undef, undef, 0.1;
    }
    die "$what did not come up on port $port - see example/var/$what.log:\n"
          . `tail -5 $EXAMPLE/var/$what.log 2>/dev/null`;
}

# ---------------------------------------------------------------------------

File::Path::make_path("$EXAMPLE/var");

# The incident flag is a FILE now, because a package variable is per worker
# and this starts a pool. A stale one left by a killed run would start the
# demo already broken, which is a confusing first thirty seconds.
unlink "$EXAMPLE/cards/var/incident";

# A port left occupied by an earlier run is the most common way a demo fails,
# and "Address already in use" three screens down a log file is not a useful
# way to find out. Checked before anything is started, and named.
{
    require IO::Socket::INET;
    my @busy;
    for my $name (sort keys %PORT) {
        my $s = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
                                      PeerPort => $PORT{$name},
                                      Proto => 'tcp', Timeout => 1);
        if ($s) { close $s; push @busy, "$name ($PORT{$name})" }
    }
    die "already listening: " . join(', ', @busy) . "\n"
      . "Something is using those ports - an earlier run, most likely:\n"
      . "  pkill -f 'plackup.*app.psgi'\n" if @busy;
}

# SEED BEFORE THE FORK. Rules, dashboards and health targets go in through
# the distribution's own writers, once, from this one process - four workers
# upserting the same names concurrently is a UNIQUE-constraint race one of
# them loses at boot.
{
    local $ENV{DEMO_STORE} = $STORE;
    my $rc = system($^X, @INC_ARGS, '-I', "$EXAMPLE/observe/lib", '-e',
        'require Demo::DB; Demo::DB::seed(); Demo::DB::seed_dashboards(); '
      . 'Demo::DB::seed_health();');
    die "seeding failed\n" if $rc;
    print "  seeded rules, dashboards, health targets\n";
}

print "starting (server: $SERVER)\n";
print "  NOTE: Hyperman is not installed, so a slow dependency will block.\n"
    if $SERVER ne 'Hyperman';

# The receiver FIRST, so the services have somewhere to export to from their
# very first request. An SDK with no endpoint exports nothing and costs
# nothing, which is correct behaviour and a boring demo.
spawn('observe', 'observe', $PORT{observe}, DEMO_STORE => $STORE);
wait_for($PORT{observe}, 'observe');
printf "  observe  http://127.0.0.1:%d/     (UI /observe, OTLP /v1)%s\n",
    $PORT{observe},
    $SERVER eq 'Hyperman' ? ", $WORKERS workers" : "";

my %otel = (
    # The BASE, not the ingest path. An OTLP exporter appends /v1/traces,
    # /v1/metrics and /v1/logs to whatever this names - the paths are fixed by
    # the specification. Putting /v1 here too produces /v1/v1/traces, which is
    # a 404 that looks like the receiver is broken.
    OTEL_EXPORTER_OTLP_ENDPOINT => "http://127.0.0.1:$PORT{observe}",
    OTEL_EXPORTER_OTLP_PROTOCOL => 'http/protobuf',
    # Small batches and a short delay, because a demo that exports every five
    # seconds looks broken for the first five seconds.
    OTEL_BSP_SCHEDULE_DELAY     => 1000,
    OTEL_BSP_MAX_EXPORT_BATCH_SIZE => 64,
);

spawn('cards', 'cards', $PORT{cards}, %otel);
wait_for($PORT{cards}, 'cards');
printf "  cards    http://127.0.0.1:%d/     service.name=cards\n", $PORT{cards};

spawn('shop', 'shop', $PORT{shop}, %otel,
      DEMO_CARDS_URL => "http://127.0.0.1:$PORT{cards}");
wait_for($PORT{shop}, 'shop');
printf "  shop     http://127.0.0.1:%d/     service.name=shop\n", $PORT{shop};

# THERE IS NO EVALUATOR PROCESS ANY MORE. The distribution registers
# observe.evaluate as a cron on the queue at plugin registration, and the
# worker below runs it - which is the point of the exercise: a host writes
# no loop, and the demo proves it by not having one.


# THE QUEUE WORKER, which is what actually runs the health poll.
#
# `cron '* * * * *' => ...` in Demo::Observe declares the task and reconciles
# it into pq_crons when the app compiles - but a declared cron fires only
# inside a worker pool, and the web servers above are not one. Without this
# the Service health table sits at "never polled" for ever, with the targets
# configured and nothing asking them anything.
#
# The scheduler runs IN this pool, which is why the task takes the leader
# lease itself: with more than one worker they would otherwise each fire the
# same minute, and the check history would be N times the traffic with a
# meaningless `ms` series.
{
    my $pid = fork();
    die "fork: $!" unless defined $pid;
    if (!$pid) {
        local $ENV{DEMO_STORE} = $STORE;
        chdir "$EXAMPLE/observe" or die "chdir: $!";
        open STDOUT, '>>', "$EXAMPLE/var/queue.log" or die $!;
        open STDERR, '>&', \*STDOUT or die $!;
        $| = 1;
        exec $^X, @INC_ARGS, "-Ilib", _punk_queue(),
             'worker', '--app', 'Demo::Observe', '-j', '1', '--interval', '0.5'
            or die "exec punk-queue: $!";
    }
    push @kids, [ 'queue', $pid, 0 ];
    print "  queue worker (health cron)            var/queue.log\n";

}

print "\n";

if (!$traffic) {
    print "running. Ctrl-C to stop.\n";
    print "  drive it:  ./bin/traffic --seconds 60\n";
    print "  break it:  curl -X PUT '127.0.0.1:$PORT{cards}/incident?on=1'\n";
    sleep 1 while 1;

}

# ---- traffic ---------------------------------------------------------------

my $rc = system($^X, @INC_ARGS, "$HERE/traffic",
                '--shop',  "http://127.0.0.1:$PORT{shop}",
                '--cards', "http://127.0.0.1:$PORT{cards}",
                '--seconds', $seconds, '--incident');

print "\n";
print "what to look at:\n";
printf "  http://127.0.0.1:%d/observe/alerts   evaluated, and RECORDED\n",
    $PORT{observe};
printf "  sqlite3 %s/config.db 'SELECT * FROM alert_events'\n", $STORE;
printf "  ls %s/default/wal/\n", $STORE;
print "  var/observe.log, var/shop.log, var/cards.log, var/queue.log\n\n";

print "leaving the servers up. Ctrl-C to stop.\n";
sleep 1 while 1;
