### demo-server.perl — Web-based oscilloscope HTTP server  -*- JavaScript -*-

### Ivan Shmakov, 2016

## To the extent possible under law, the author(s) have dedicated all
## copyright and related and neighboring rights to this software to the
## public domain worldwide.  This software is distributed without any
## warranty.
##
## You should have received a copy of the CC0 Public Domain Dedication
## along with this software.  If not, see
## <http://creativecommons.org/publicdomain/zero/1.0/>.

### Code:

use common::sense;

use HTTP::Status qw (HTTP_OK HTTP_FORBIDDEN HTTP_SERVICE_UNAVAILABLE);

require HTTP::Daemon;
require HTTP::Response;
require IO::Select;
require POSIX;                  ## for atan ()

my $delay
    = .1;
my $port
    = 2080;
my ($max_frames, $frame_samples)
    = (8, 512);
my ($amplitude, $period, $phase_0)
    = (32767, 337, 0);

my $daemon
    = HTTP::Daemon->new ("LocalPort" => $port)
    or die ();
warn ("I: Listening at ", $daemon->url (), "\n");

my ($next_frame, $frames, @cycbuf)
    = (0, 0, ((undef) x $max_frames));
my $phase
    = $phase_0;
my $select
    = IO::Select->new ($daemon);
while (1) {
    my @ready
        = $select->can_read ($delay);
    if (@ready > 0) {
        my $c
            = $daemon->accept ();

        my $r;
        unless (defined ($r = $c->get_request ())) {
            warn ("W: Cannot get a request: ", $c->reason ());
            next;
        }

        ## FIXME: handle more than one request per connection
        ## Alternatively, add $c to $select and iterate over @ready.
        $c->force_last_request ();

        unless ($r->method () eq "GET") {
            warn ("W: Unknown request method, rejected: ", $r->as_string ());
            $c->send_error (HTTP_SERVICE_UNAVAILABLE,
                            "Request not understood");
            next;
        }

        my $uri
            = $r->uri ();
        if ($uri->path () ne "/data") {
            my ($fn)
                = ($uri->path () =~ m { ^/([a-z.]+)$ }x);
            unless (defined ($fn) && -f $fn && -r $fn) {
                warn ("W: Access denied: ", $fn, "\n");
                $c->send_error (HTTP_FORBIDDEN,
                                "Access denied");
                next;
            }
            $c->send_file_response ($fn);
            $c->close ();
            next;
        }

        my ($f)
            = ($uri->query ()
               =~ m { (?: ^ | &) f=([0-9]+) (?: & | $) }x);

        ## FIXME: check for $next_frame counter overflows?
        my $first_frame
            = ($next_frame - $frames);
        $f
            = $first_frame
            unless (defined ($f)
                    && $f >= $first_frame && $f <= $next_frame);

        my $body
            = pack ("N", $frame_samples);
        for (undef; $f < $next_frame; $f++) {
            $body
                .= (pack ("N", $f) . $cycbuf[$f % @cycbuf]);
        }

        my $headers = [
            "Content-Type" => "application/octet-stream"
        ];
        my $response
            = HTTP::Response->new (HTTP_OK, undef, $headers, $body);
        $c->send_response ($response);
        $c->close ();
    }

    my $fi
        = $next_frame % @cycbuf;
    {
        my ($m, @a)
            = (8 * POSIX::atan (1) / $period,
               (undef) x $frame_samples);
        for (my $i = 0; $i < @a; $i++) {
            $a[$i]
                = int ($amplitude * (1 + sin ($phase + $m * $i)));
        }
        $phase
            += $m * $frame_samples;
        $cycbuf[$fi]
            = pack ("n*", @a);
    }
    ++$next_frame;
    ++$frames
        if ($frames < @cycbuf);
}

### demo-server.perl ends here