Archive
Ungolden silence
On my quest to replace Bash with Raku I tried to use qx and failed. It didn’t work for me because qx fails the wrong way. Under the hood Rakudo implements it by some grammar magic that forwards to QX in core.c/Proc.pm6 as follows.
sub QX($cmd, :$cwd = $*CWD, :$env) is implementation-detail {
my $proc := Proc.new(:out);
$proc.shell($cmd, :$cwd, :$env);
$proc.out.slurp(:close) // Failure.new("Unable to read from '$cmd'")
}This will return an empty Str, an non-empty Str or a Failure object. So this can be defined but False, defined but True or undefined but False. We get the undefined case when the shell that shell starts unexpectedly closes its STDOUT descriptor. We can get something that is False even if the command succeeds and we can get something that is True if the comand fails. On Unix silence is gold. Unless you provide -v or --verbose any command that does not need to output should not. If there is something wrong a non-zero exit code is returned and if ever possible something is written to STDERR. QX ignores exitcodes and stderr is forwarded to $*ERR. So we have little chance the catch it after the fact.
This behaviour will create hard to catch bugs. Let’s make a typo.
my $s = qx!True!;
say [$s.?defined, $s.?Bool, $s.?exitcode];
dd $not-proc;/bin/sh: 1: True: not found [True False (Any)] Str $s = ""
Using the defined-or operator wont help here. Nor would try. Does anybody use qx and try?
dex@dexhome:~/projects/raku/rakudo/src$ ack 'QX'
core.c/Process.pm6
82: once if !Rakudo::Internals.IS-WIN && try { qx/id/ } -> $id {
On Windows that might actually fail as expected. On any other platform we need something sane.
sub sane-QX($cmd, :$cwd = $*CWD, :$env, :$quiet) {
my $proc := Proc.new(:out, :err);
$proc.shell($cmd, :$cwd, :$env);
my $stdout = $proc.out.slurp(:close) // Failure.new("Unable to read from '$cmd'");
my $stderr = $proc.err.slurp(:close);
$*ERR.print: $stderr unless $quiet;
if $proc.exitcode != 0 {
return "" but role QXFail {
method defined { False }
method exitcode { $proc.exitcode }
method err { $stderr }
}
}
$stdout
}
my $sane = sane-QX(‚True‘);
say [$sane.?defined, $sane.?Bool, $sane.?exitcode, $sane.?err];
say sane-QX(‚True‘) // ‚I has a booboo!‘;I’m not sure if just mixing undefinedness in is the right way. Maybe an exception with the exitcode and STDERR content would be better. That way the error handling can be moved into a CATCH block.
I will ponder this a little longer and then file a bug report. If it turns out the current implementation is desired the docs will need some warning stickers.
Watching new arrivals
Any boring recurring task must be as easy as possible or it will be neglected. I’m quite sure this is why we invented computers. Backups are kinda borring. In fact you want to avoid any form of excitement when it comes to backups. So they must be as easy as possible. I have a script that is triggered by a udev rule when a new device is added. This is working fine when a single disk is plugged in. (This works very well.) I got a usb hub with a few usb sticks that form a btrfs raid5 for making quick backups of my $home whenever I switch the usb hub on. This does not work fine in some cases. Getting a bash script to check if a drive in a set is missing ain’t fun. Mostly because only proper languages come with Set. We do have a proper language.
On linux it is fairly easy to find out if a drive was plugged in. All we need to do is to watch for new files to pop up in /dev/disk/by-id/. We can also learn if new partitions where found. The directory looks like the following.
$ ls -1 /dev/disk/by-id/ ata-CT120BX500SSD1_1902E16BC135 ata-CT120BX500SSD1_1902E16BC2AA ata-TOSHIBA_HDWQ140_X83VK0GDFAYG ata-TOSHIBA_HDWQ140_X83VK0GDFAYG-part1 ata-TOSHIBA_HDWQ140_X83VK0GDFAYG-part2 ata-TOSHIBA_HDWQ140_X83VK0GDFAYG-part3 ata-TOSHIBA_HDWQ140_Y8J9K0TZFAYG ata-TOSHIBA_HDWQ140_Y8J9K0TZFAYG-part1 ata-TOSHIBA_HDWQ140_Y8J9K0TZFAYG-part2 ata-TOSHIBA_HDWQ140_Y8J9K0TZFAYG-part3 usb-SanDisk_Ultra_USB_3.0_4C530001160708110455-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001190708111070-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001220708110370-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001280708111064-0:0 wwn-0x50000398dc60029a wwn-0x50000398dc60029a-part1 wwn-0x50000398dc60029a-part2 wwn-0x50000398dc60029a-part3 wwn-0x50000398ebb01681 wwn-0x50000398ebb01681-part1 wwn-0x50000398ebb01681-part2 wwn-0x50000398ebb01681-part3
If we look for anything that doesn’t end in '-part' \d+ we got a drive. We can also tell where it’s plugged in by checking the prefix.
sub scan-drive-ids(--> Set) {
my Set $ret;
for '/dev/disk/by-id/'.IO.dir.grep(!*.IO.basename.match(/'part' \d+ $/)) {
$ret ∪= .basename.Str;
CATCH { default { warn .message } }
}
$ret
}
my %last-seen := scan-drive-ids;Sets don’t got an append method. We can substitude that with ∪=. Now we got a lovely Set of drives in %last-seen that are already there. We now need to wait for new files to pop up and apply set theory to them.
react {
whenever IO::Notification.watch-path('/dev/disk/by-id/') {
my %just-seen := scan-drive-ids;
my %new-drives := %just-seen ∖ %last-seen;
my %old-drives := %last-seen ∩ %just-seen;
my %removed-drives := %last-seen ∖ %just-seen;
%last-seen := %just-seen;
# say ‚old drives: ‘, %old-drives.keys.sort;
say ‚new drives: ‘, %new-drives.keys.sort || '∅';
say ‚removed drives: ‘, %removed-drives.keys.sort || '∅';
}
}By binding the Sets to an Associative container we get for and other buildins to behave. If we want to take action if certain disks are added we need to define Sets that contain the right file names.
my %usb-backup-set = Set(<usb-SanDisk_Ultra_USB_3.0_4C530001160708110455-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001190708111070-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001220708110370-0:0 usb-SanDisk_Ultra_USB_3.0_4C530001280708111064-0:0>);
my %root-backup-disk = Set(<ata-TOSHIBA_DT01ACA200_8443D04GS>);
my $delayed-check := Channel.new;
my Promise $timeout-promise;
react {
whenever IO::Notification.watch-path('/dev/disk/by-id/') {
my %just-seen := scan-drive-ids;
my %new-drives := %just-seen ∖ %last-seen;
my %old-drives := %last-seen ∩ %just-seen;
my %removed-drives := %last-seen ∖ %just-seen;
%last-seen := %just-seen;
# say ‚old drives: ‘, %old-drives.keys.sort;
say ‚new drives: ‘, %new-drives.keys.sort || '∅';
say ‚removed drives: ‘, %removed-drives.keys.sort || '∅';
if %usb-backup-set ∩ %new-drives {
$timeout-promise = Promise.in(5).then: {
$delayed-check.send: True;
$timeout-promise = Nil;
} without $timeout-promise;
}
if %root-backup-disk ∩ %new-drives {
sleep 2;
backup-root-and-home-to-disk(%root-backup-disk);
}
say '';
}
whenever $delayed-check {
my %just-seen := scan-drive-ids;
if %usb-backup-set ⊆ %just-seen {
backup-home-to-usb(%usb-backup-set);
} elsif %usb-backup-set ∩ %just-seen {
warn 'drive missing in usb set: ' ~ (%usb-backup-set ∖ (%usb-backup-set ∩ %just-seen)).keys;
reset-usb-hub;
}
}
}I use the $delayed-check whenever-block to handle the case when one of the usb sticks refuses to come online. The vendorid and deviceid of the usb hub are hardcoded. Please note that state and start don’t mix well.
sub reset-usb-hub(--> True) {
state $reset-attempt = 0;
if $reset-attempt++ {
say ‚already reset, doing nothing‘;
$reset-attempt = 0;
} else {
say ‚Resetting usb hub.‘;
my $usb_modeswitch = run <usb_modeswitch -v 0x2109 -p 0x0813 --reset-usb>;
fail ‚resetting usb hub failed‘ unless $usb_modeswitch;
}
}The entire script can be found here. I believe the example of watch-path could use a modified version of this script. If you read it you can tell where Sets are used simply by spotting set operators. Making Raku a operator oriented language was a good idea. Thank you Larry.
While turning my backup script from Bash to Raku I had some more findings about shell scripting in a proper language. I shall report about them here in the next few weeks.
Returning the right amount
Do you know that look your better halve gives you when you return with the wrong number of items from the groceries? Tell you what, we will write a script for that!
sub buy-eggs($amount --> Seq where *.elems == $amount) {
my $forgotten-amount = (1..$amount).roll;
return "egg" xx $amount - $forgotten-amount;
}
say buy-eggs 10;Cannot do non-typename cases of type_constraint yet
at /home/dex/projects/blog/return-check.raku:3
------> $amount --> Seq where *.elems == $amount⏏) {
Raku failed us! But Raku being Raku we are allowed to help it.
multi sub trait_mod:<is>(Sub $s, :return-where(&condition)) {
$s.wrap({
my $ret = callsame;
if !condition($ret) {
fail ‚return condition does not match for sub ‘ ~ $s.name ~ ‚ for return value of ‘ ~ $ret.gist;
}
$ret
});
}Now we can check if a sub returns a certain amount of elements.
sub buy-eggs($amount --> Seq) is return-where(*.elems == 10) {...}There is a catch though. In contrast to a where-clause a trait does not have access to variables in the scope of the signature. We can use a POST phaser for that.
sub buy-eggs($amount --> Seq) {
my $forgotten-amount = (1..$amount).roll;
return "egg" xx $amount - $forgotten-amount;
POST { $_ == $amount or fail "back to the store!" }
}
A proper where clause on the return check would be nice for documentation. If we can move any input and output validation into the signature that signature becomes a description of the input and output values. And quite in contrast to hand written documentation it stays in sync with the code.
I hope that the prospect of spouse agro will convince the core devs to add where clauses to return checks.
The mysterious infix
Vadim Belman informed us that he started a module for writing GUI apps in the console. That gave me a massive flashback to the nineties. Looking at the example code got me the next flashback. If you need a button you need to subclass. In fact if you need anything you need to subclass. In a dynamic language with lexical scoping that might actually work.
Looking at the code one can see lots and lots of Raku features to be used. I even found this gem.
$!id = ++⚛$sequence;That’s clearly not from the nineties. Back then real programmers could get anything done with just one core!
There are a few examples Vadim wrote for us and the interface for his module look pretty 90ish again. Which made me think for a while how a “modern” interface could look like. In the process I didn’t come up with something better but stepped on a bug.
As it turns out is looser(&infix:<:>)should be in %categorically-won't-work. There are quite a few things that wont work but are not documented. Luckily there is a workaround for defining a new operator that got looser precedence than the colon that separates a method name from its arguments.
sub infix:«add»(Parent:D \p, Child:D \c --> Parent:D) is equiv(&infix:<and>) {
p.add-child: c;
p
}
$p add Child.new: :birthday("april") add Child.new: :birthday("december");All we need to do is to be equally loose then and.
The usefulness of an add operator appeared questionalbe to me until I realised that feed operators are not. Yet Raku does not make much use of them. I believe the following should be dwimmy.
my $c = Channel.new;
$c <== "foo";Raku is still a bit incomplete. But fear not we are only at e!
Autorotating logs
While translating my backup script from bash to Raku I did a peek into /var/log/and was shocked to find 650MB of stuff I never looked at. Unsurprisingly /var/log/journal was the largest offender . Sadly I must say that systemd is very consistent in convincing me to be not very good software. The oldest offender was from 2008. Debian is very consistent in convincing me to keep it around. Even though it does not come with logrotate for xrdp.log. How hard can it be to build in rotating and compressing logs into your own software?
That turned out to be a 60-line-problem.
sub open-logfile(IO() $log-file-path = IO::Path, :$flush = False, :$max-size = 2**20 * 50, :$max-backlog = 7 --> Routine) {
my $log-channel = Channel.new;
my $log-promise = start {
my $log-handle = $log-file-path ?? open $log-file-path, :a !! $*ERR;
my $log-file-dir = $log-file-path.dirname;
my $log-file-basename = $log-file-path.basename;
sub compress-file($path) {
my $gz = run <gzip -9>, $path;
warn „could not compress $path“ unless $gz;
}
my $log-file-length = $log-file-path ?? $log-file-path.s !! 0;
sub rotate-log {
return without $log-file-path;
note ‚rotating logfile‘;
$log-handle.close;
my @siblings = dir($log-file-dir).grep(*.basename.starts-with($log-file-basename));
for @siblings».Str.sort.skip.head($max-backlog - 1).reverse -> $path {
my $n = $path.match(/log '.' (\d+)/)[0].Int + 1;
compress-file($path) if $n == 2;
my $new-name = $log-file-path ~ '.' ~ ($n > 1 ?? $n ~ ‚.gz‘ !! $n);
($n == 2 ?? $path ~ ‚.gz‘ !! $path).IO.rename($new-name);
}
$log-file-path.rename($log-file-path ~ '.1');
$log-handle = open $log-file-path, :a;
$log-file-length = 0;
}
react whenever $log-channel -> Str() $line {
my $utf8 = ($line ~ "\n").encode;
$log-file-length += $utf8.bytes;
rotate-log if $log-file-length > $max-size;
$log-handle.write: $utf8;
$log-handle.flush if $flush;
}
}
my $last-message = "";
my int $dupe-counter = 0;
sub ($message --> Nil) {
my $now = now.DateTime;
my $timestamp = $now.yyyy-mm-dd ~ ' ' ~ $now.hh-mm-ss;
if $message eq $last-message {
$dupe-counter++;
} else {
if $dupe-counter > 0 {
$log-channel.send: $timestamp ~ ' Last message repeated ' ~ $dupe-counter ~ ' times.';
} else {
$log-channel.send: $timestamp ~ ' ' ~ $message;
}
$dupe-counter = 0;
}
$last-message = $message;
} but role :: { method close { $log-channel.close; await $log-promise } }
}
Without .flush after each line performance is good. With it it’s pretty bad given that we don’t have access to fancy linux flags for open and as such don’t really flush all that hard.
Since rotating logs and compressing them might take some time I put that actual writing to the file into its own thread. So usage becomes a bit indirect and we have to tell the logger to finish writing and close the file. If we don’t we can lose data. I’m not sure if the latter is a bug.
my &log = open-logfile(‚/tmp/test.log‘, :max-size(2**20));
my $lore = ‚Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.‘;
loop {
log(100.rand > 50 ?? $lore !! 42.rand);
last if (now - ENTER now) > 60 * 60 * 2;
}
&log.await;After much deliberation I have come to the conclusion that renaming Perl 6 to Raku was a mistake. It should have been named Exceedingly Simple.
Playing Perl 6␛b6xA Raku 
