The Siege Can Continue

A wise internet spaceship pirate once wrote: “Whining gets you stuff. That’s why humans are at the top of the food chain.”. My Whining got me a fix that put an end to segfaults on long running scripts that react to http requests.

So I continued to add missing bits to my golfed httpd and found another good use for term:<>.

constant term:<HTTP-HEADER-404> = "HTTP/1.1 404 Not Found", "Content-Type: text/plain; charset=UTF-8", "Content-Encoding: UTF-8", "";

Without term:<> the compiler would think I wanted to substract 400 from a http header.

If you got some time to spare please write a whiny blog post about a crash that is bugging you – works like a charm.

Advertisements

Goto the Last Fifo

I always admired the elegance of the sysfs. You take a text and write it to a file to talk to a function running in kernel space. As soon as you know how to work with files, you can change the systems behaviour and reuse access control mechanism without any special tools. It’s very easy to script and dump (parts) of the systems state.

Linux and friends come with fifos that serve the same purpose. Create a fifo, set access rights and start reading from that pseudo-file. Very easy to do in Perl 5.

my $fifo; open($fifo, "+);
while (<$fifo>) {
    do-things-with $_;
} 

Rakudo doesn’t really know about fifos yet, as a result it doesn’t block on a read of a fifo that don’t got data anymore. After a bit of fiddeling I found a way around that problem.

      1 use v6.c;
      2
      3 # `mkfifo radio-fifo-in`
      4 # `echo "foo" > radio-fifo-in`
      5 # `echo "foo^D" > radio-fifo-in`
      6
      7 my $fifo-in = open(„radio-fifo-in“, :r);
      8
      9 LABEL: loop {
     10     react {
     11         whenever supply { .emit for $fifo-in.lines } {
     12             say .Str;
     13             last LABEL if /‚^D‘/;
     14         }
     15     }
     16 }

I learned that whenever reacts to last and will teach the docs about it later today. Luckily Perl 6 got labels so we can tell last where to goto.

UPDATE: scovit found a short expression that gets very close to the behaviour of Perl 5.

my $fifo = open("radio-fifo-in", :r);
while defined $_ = $fifo.get { .say }

We Need to Siege Moar

Alas, my attempt to avoid bugs by moving with little load was not as fruitful as I hoped.

Siegeing my tiny httpd lasted for about an hour and then the gates gave way. With dmesg the culprit was swiftly revealed.

[4361268.087988] moar[12491]: segfault at 3c8b ip 00007f86b426868b sp 00007f86aaff86b0 error 4 in libmoar.so[7f86b407b000+55d000]

A had the suspicion that close to 70000 tests will only get us the failure modes that are cought within minutes. Looks like there is quite some squashing left to do for the moar team.

Golfing httpd

I’m building a internet radio player and wanted both a curses and web interface to switch stations. Looking at the various modules in the ecosystem provided lots of options that do lots of things. I had a bug hunt in those field a while ago and didn’t like it. The amount of httpd I need is fairly small and I thought to myself: „Somebody should golf that!“. And so I did.

The objective is to have as little http as I can get away with. I want to display the names of available stations and receive a station-id to switch stations. And maybe a stop, play and record button. That can be done with with lines of text. So text/plain it is.

I can stuff channel-ids and button names into URLs. What means implementing only GET will do. Caching or other fancy stuff wont be needed, what makes the HTTP-header static. The most complex thing to do would be taking the URL apart.

That’s what I came up with:

my sub term:<now>() { DateTime.now.Instant but role :: { method Str { self.DateTime.hh-mm-ss } } };
my &BOLD = $*OUT.t ?? sub (*@s) { "\e[1m{@s.join('')}\e[0m" } !! sub (|c) { c };

constant HTTP-HEADER = "HTTP/1.1 200 OK", "Content-Type: text/plain; charset=UTF-8", "Content-Encoding: UTF-8", "";
constant term:<HTTP-HEADER-404> = "HTTP/1.1 404 Not Found", "Content-Type: text/plain; charset=UTF-8", "Content-Encoding: UTF-8", "";

react {
    whenever IO::Socket::Async.listen('0.0.0.0', 8080) -> $conn {
        note „{now} incomming connection from {$conn.peer-host}:{$conn.peer-port}“;
        my @msg = HTTP-HEADER;
        whenever $conn.Supply.lines {
            if /^GET  (<[\w„/“]>+) [„HTTP“ \d „/“ \d]? / {
                note „{now} GET $0“;
                given $0.Str {
                    @msg.push: „running since {BEGIN now} UTC“ when „/status“;

                    @msg.push: „Hello World!“ when „/“;

                    done when „/exit“
                    default {
                        @msg = HTTP-HEADER-404;
                        @msg.push: „Resource {.Str} not found.“;
                    }
                }
            }

            if /^$/ { 
                for {
                    once note .Str;
                    $conn.print(.Str ~ "\n")
                }
                $conn.close;
            }
        }
        CLOSE {
            note „{now} connection closed“;
        }
        CATCH { default { warn BOLD .^name, ': ', .Str; warn BOLD "handled in $?LINE"; } }
    }
}

The whole thing waits for a connection. Then takes the URL apart and fills an Array with lines of text. That Array is then send back to the client. A few lines of logging and error handling.

The less code there is the less ground a bug hunter has to cover. Luckily Perl 6 is very friendly to golfers.

UPDATE: Add proper handling of the http header terminator, what leads to less error handling. Also, add some more log output.

Hunting Documented Bugs

AlexDaniel came up with and Zoffix made some propaganda for a reoccuring bug hunt. This weeks pray are doc issues. In the following are detailed instructions on how to get dressed up.

zef install META6::bin
meta6 --fork-module=p6doc
cd doc
zef --deps-only install .
# you may have to add $HOME/.perl6/bin to $PATH
# edit away
git push
meta6 --pull-request --title='add t/meta.t'
# goto edit away

If you never used META6::bin you may have to do some setup.

Out of Order Mystery

Judging by our irc logs Proc::Async seams not to be well documentent. In the following I shall procide some answers and hopefully raise the missing questions so we can fill another few holes in the docs.

First some code with line numbers.

      1 #! /usr/bin/env perl6
      2
      3 use v6.c;
      4
      5 my $line-source = Proc::Async.new("perl6", "bin/line-source.p6", :w);
      6
      7
      8 react {
      9     whenever $line-source.stdout -> $l is copy {
     10         $line-source.put: $l++;
     11         # die "ouch!" if $++ > 100;
     12     }
     13     whenever $line-source.start {
     14         say "exitcode: ", .exitcode; done
     15     }
     16     whenever signal(SIGINT) {
     17         say "sigint: $_";
     18         $line-source.close-stdin;
     19         exit 0
     20     }
     21     whenever Promise.in(5) {
     22         note "timeout";
     23         $line-source.kill;
     24     }
     25     whenever Promise.in(2) { $line-source.put: 1 }
     26
     27     CONTROL { say "control: $_"; }
     28     CATCH { say .^name, ': ', .Str; }
     29     LEAVE { say "LEAVE"; }
     30     CLOSE { say "CLOSE"; }
     31 }

And now the order of execution of those lines.

Any line with a whenever statement is executed in the order given but the whenever block itself is delayed. Think of it as a setup phase.

The first line executed in the react block is the leave block in line 29. The whole point of a react block is to add one or many invisible awaits that take over control flow inside the block. Any exception fired inside any whatever and the surrounding react block will be handled in the CATCH block of line 28. If any exception is forcing any Supply to be closed, the CLOSE block will be run. Normal execution wont (this may be a bug).

If no odd things happend, line 10 is run whenever a newline shows up in STDOUT. The signal handler at line 17 is fired when the signal is processed (that can take a bit). The timeout of 5 seconds may take more then 5 seconds but it will close STDIN and as such force line 14 to be executed. If the program started in line 13 exits on its own, line 14 will be run as well.

The block in line 25 is executed after at least 2 seconds after setup.

There are likely bits I missed. Your questions are very welcome. I for one need rest now to get my brain back in order.

UPDATE: There is no timeout for reads from buffered programs. So if they don’t have a timeout on their own, they may hang until STDIN is closed.

Preparations for your

In his excellent speech Damian Conway showed how to implement a new declarator he called your that will output any value change to the container for debugging. The whole thing made me worry that Perl 5 might overtake Perl 6 causing even more naming confusion as we got already. So I set out to get us ahead a little again.

We can’t easily implement declarators in Perl 6 yet but fancy containers are no problem. All we need is a Proxy that does a type check. The latter can be achived with a type capture in the constructor.

class Watched {
    has Mu $.container is rw;
    my $quote-start = '⟨';
    my $quote-end = '⟩';

    method new(::T, :$name = '<unnamed>') {
        my $self = self.bless(:container(T));
        Proxy.new(
            FETCH => method () { $self.container },
            STORE => method (T $new-value) {
                temp $quote-start;
                temp $quote-end;
                if $*ERR.t {
                    $quote-start := "\e[7m";
                    $quote-end := "\e[0m";
                }
                note "Container $name changed from {$quote-start ~ $self.container.gist ~ $quote-end} to {$quote-start ~ $new-value ~ $quote-end}";
                $self.container = $new-value
            }
        )
    }
}

The get a container stick we need to use binding. Sadly without proper macro support there is no way to get hold of the container name automatically because Proxy does not support the same interface as Scalar. At the other hand providing it manuelly gives a little more flexibility.

my $c := Watched.new(Int, :name<$c>);

dd $c; # Int
$c = 42; # STDERR: Container $c changed from (Int) to 42
dd $c; # 42

I hope to have shown that one more level of indirection works equally well in Perl 5 and Perl 6.

UPDATE: If we output to STDERR we better test if $*ERR is a tty.