Feeds:
Posts
Comments

Archive for April, 2010

This is part 4 in my occasional AnyEvent series

When I tried to move my AnyEvent-based code over to Windows today, I got a slightly unpleasant surprise.

$ perl kernel.pl
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

(Actually, that path is not accurate – it is from simulating the problem on a different computer. The actual path is a network share.)

Drat I thought, maybe AnyEvent isn’t as portable as I thought. But hang on a minute. When doubting a widely used library ahead of your own code, it is usually your code that is at fault. In my experience anyhow. And besides, Twiggy runs on Windows. What have I done wrong?

So I had a look at the offending line of code.

# Sets the blocking state of the given filehandle (true == nonblocking,
# false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
# broken (i.e. windows) platforms.

BEGIN {
   *fh_nonblocking = AnyEvent::WIN32
      ? sub($$) {
          ioctl $_[0], 0x8004667e, pack "L", $_[1]; # FIONBIO
        }
      : sub($$) {
          fcntl $_[0], AnyEvent::F_SETFL, $_[1] ? AnyEvent::O_NONBLOCK : 0;
        }
   ;
}

While I was there, a quick glance down the comments gave me a picture of someone who enjoys working on Windows as much as I do :)

# perl's socketpair emulation fails on many vista machines, because
# vista returns fantasy port numbers.

...

# vista has completely broken peername/sockname that return
# fantasy ports. this combo seems to work, though.

...

# vista example (you can't make this shit up...):

I quickly tracked the root of the problem down to a file called constants.pl. Uh oh, take a look at the WIN32 subroutine.

package AnyEvent;
sub CYGWIN () { 0 }
sub WIN32 () { 0 }
...

That is actually a file generated from a Unix install of AnyEvent. constants.pl is generated at make time from a file called constants.pl.PL that looks like this.

sub i($$) {
   print "sub $_[0] () { ", $_[1]*1, " }\n";
}

print "package AnyEvent;\n";

our $WIN32 = $^O =~ /mswin32/i;

i CYGWIN => $^O =~ /cygwin/i;
i WIN32  => $WIN32;
...

And this is down to my company’s perl policy. A number of pure perl modules are installed on a windows network share which is samba mounted onto the unix servers. We’re primarily a C++/Java shop and Perl is something of a second-class citizen but there are a good number of modules available (including Moose, AnyEvent, POE, etc.)

The downside is that it is hard to get modules installed that aren’t there already, and we are not permitted to download them ourselves. Most of the time, this isn’t a problem.

Anyway, I tried to fix this in my own script using variants on:

package AnyEvent;
use constant WIN32 => 1;
package Kernel;

and

sub AnyEvent::WIN32 () { 1 }

both before and after the use AnyEvent lines. I couldn’t get round it though. This happened when the definitions were after the use lines.

$ perl kernel.pl
Constant subroutine AnyEvent::WIN32 redefined at c:/strawberry/perl/lib/constant.pm line 131.
Constant subroutine AnyEvent::WIN32 redefined at kernel.pl line 23.
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

And this is when it was placed before.

$ perl kernel.pl
Constant subroutine WIN32 redefined at c:/strawberry/perl/site/lib/AnyEvent/constants.pl line 3.
fcntl is not implemented at c:/strawberry/perl/site/lib/AnyEvent/Util.pm line 362.

How frustrating!

Read Full Post »

list_processes aka ps

This is part 3 in my occasional AnyEvent series

Now that we have our userspace kernel, it is time to write the utilities to make it more pleasant to use. On Linux, I can simulate all of the commands using telnet, but my Windows box doesn’t have telnet installed. I will therefore need a list_processes command, a signal command and a library to help with registering new processes.

First up is list_processes which is modelled on the http_get function presented in AnyEvent::Intro. It simply needs to send:

list_processes\015\012

and then call the passed in function with each line of response. The result might be something like the following.

$ ./list_processes.pl
1: ./register.pl a b c
2: ./register.pl

list_processes.pl

use 5.010;

use strict;
use warnings;

use constant DEBUG => $ENV{KERNEL_DEBUG};

my $cr = "\015\012";

use AnyEvent::Handle;

sub list_processes
{
    my ($host, $port, $cb) = @_;

    my $cv = AE::cv();

    my $handle; $handle = AnyEvent::Handle->new(
        connect  => [$host => $port],
        on_error => sub {
            say("Connection error: $!");
            $handle->destroy();
        },
        on_eof => sub {
            DEBUG && say 'Connection closed';
            $handle->destroy();
            $cv->send();
        }
    );

    $handle->push_write('list_processes' . ${cr});

    $handle->on_read(sub {
        my $handle = shift;
        my $data = $handle->rbuf();
        $handle->rbuf() = '';
        $data =~ tr/\r//d;
        foreach my $line (split /\n/, $data) {
            $cb->($line);
        }
    });

    return $cv;
}

my $cv = list_processes('localhost', 12345, sub { say @_ } );
$cv->recv();

Read Full Post »

This is part 2 in my occasional AnyEvent series

As we already discovered, signals don’t work in Strawberry Perl [on Windows]. As they are so useful, we really want a way to emulate them. I can think of a few approaches, but the most obvious is to have a userspace "kernel" sitting on a socket which all processes register with.

The kernel will respond to a few commands

register: [args]
list_processes           # ps :)
signal: [pid] [message]  # similar to kill, but more flexible

A quick disclaimer: for the sake of brevity, I’ve omitted authentication and error handling.

Kernel Code

The server again uses AnyEvent and start_listen(), prepare_handler() and _accept_handler() should look pretty familiar.

Twiggy uses AE::io and checks errno for its conditions. I guess this is done for speed as AnyEvent::Handle is much easier to use.

sub watch_socket
{
    my ($self, $sock) = @_;

    # Closure variables
    my $pid = -1;

    my $handle; $handle = AnyEvent::Handle->new(
        fh  => $sock,
        on_error => sub {
            say "Error: $! (PID $pid)";
            $handle->destroy;
        },
        on_eof => sub {
            say "Disconnected (PID $pid)";
            delete $self->{watchers}{$pid};
            $handle->destroy;
        },
    );

    $handle->push_read(line => sub {
        my ($handle, $command) = @_;

        DEBUG && say "Received [$command]";

        # valid commands are:
        #     register: [args]
        #     list_processes
        #     signal: [pid] [message]

        if ($command =~ /^register:\s+(.+)/) {
            my $args = $1;
            $pid = ++$self->{pid};
            $self->register_watcher($handle, $pid, $args);
            # Don't set on_drain(...)
            return;
        } elsif ($command eq 'list_processes') {
            $self->list_processes($handle);
        } elsif ($command =~ /^signal:\s+(\d+)\s+(.+)/) {
            my ($pid, $message) = ($1, $2);
            $self->send_signal($handle, $pid, $message);
        } else {
            say 'Error: unrecognised command';
            $handle->push_write("Invalid command [$command]" . ${cr});
        }

        # For all commands apart from register, we want to close the
        # socket after sending the response which we do by setting
        # on_drain(...)
        $handle->on_drain(sub { $handle->destroy(); });
    });
}

register_watcher

register_watcher stores the handle and the information about the process in the object. It informs the process which PID has been given to the process. (I am still considering the registering process sending $$ to use as the PID).

sub register_watcher
{
    my ($self, $handle, $pid, $args) = @_;
    DEBUG && say "Registering [$args] (PID $pid)";

    $handle->keepalive(1);
    $self->{watchers}{$pid} = { handle => $handle, args => $args };
    $handle->push_write("Connected.  (PID $pid)" . ${cr});
    # on_read(...) needs to be set, otherwise disconnects from the
    # client side are not always detected
    $handle->on_read(sub { });
}

list_processes

list_processes gives a process list of processes that are registered with the kernel. This is similar, but uglier to ps(1).

sub list_processes
{
    my ($self, $handle) = @_;

    foreach my $pid (sort { $a <=> $b } keys %{$self->{watchers}}) {
        my $args = $self->{watchers}{$pid}{args};
        $handle->push_write("$pid: $args" . ${cr});
    }
}

send_signal

send_signal looks up the handle belonging to the process in $self->{watchers}. If it is registered, it is possible to send any message to the process, otherwise it returns an error message. I’ve added special handling to a disconnect message, allowing

This is the dangerous bit. kill(1) has some protection in that you are only able to send signals to processes you own (unless you are root). The implementation, as presented here, allows anyone who can telnet to the kernel port to send any message to any process that is registered. It would be necessary to add a layer of authentication and process ownership if the goal really was to provide something similar to unix signals.

sub send_signal
{
    my ($self, $handle, $pid, $message) = @_;

    if (! exists($self->{watchers}{$pid})) {
        say "Error: PID $pid does not exist";
        $handle->push_write("PID $pid does not exist" . ${cr});
    } else {
        my $process = $self->{watchers}{$pid}{handle};
        $process->push_write('signal: ' . $message . ${cr});
        if ($message eq 'disconnect') {
            delete $self->{watchers}{$pid};
            $process->on_drain(sub { $process->destroy(); });
        }
    }
}

kernel.pl – complete source

#!perl

use 5.010;

use strict;
use warnings;

package Kernel;

use constant DEBUG => $ENV{KERNEL_DEBUG};

my $cr = "\015\012";

use AnyEvent;
use AnyEvent::Handle;
use AnyEvent::Socket;

sub new
{
    my $class = shift;
    my $self = { pid => 0, watchers => {} };
    bless $self, $class;
    return $self;
}

sub register_watcher
{
    my ($self, $handle, $pid, $args) = @_;
    DEBUG && say "Registering [$args] (PID $pid)";

    $self->{watchers}{$pid} = { handle => $handle, args => $args };
    $handle->push_write("Connected.  (PID $pid)" . ${cr});
    $handle->on_read(sub { });
}

sub list_processes
{
    my ($self, $handle) = @_;

    foreach my $pid (sort keys %{$self->{watchers}}) {
        my $args = $self->{watchers}{$pid}{args};
        $handle->push_write("$pid: $args" . ${cr});
    }
}

sub send_signal
{
    my ($self, $handle, $pid, $message) = @_;

    if (! exists($self->{watchers}{$pid})) {
        say "Error: PID $pid does not exist";
        $handle->push_write("PID $pid does not exist" . ${cr});
    } else {
        my $process = $self->{watchers}{$pid}{handle};
        $process->push_write('signal: ' . $message . ${cr});
        if ($message eq 'disconnect') {
            delete $self->{watchers}{$pid};
            $process->on_drain(sub { $process->destroy(); });
        }
    }
}

sub watch_socket
{
    my ($self, $sock) = @_;

    # Closure variables
    my $pid = -1;

    my $handle; $handle = AnyEvent::Handle->new(
        fh  => $sock,
        on_error => sub {
            say "Error: $! (PID $pid)";
            $handle->destroy();
        },
        on_eof => sub {
            say "Disconnected (PID $pid)";
            delete $self->{watchers}{$pid};
            $handle->destroy();
        },
    );

    $handle->push_read(line => sub {
        my ($handle, $command) = @_;

        DEBUG && say "Received [$command]";

        if ($command =~ /^register:\s+(.+)/) {
            my $args = $1;
            $pid = ++$self->{pid};
            $handle->keepalive();
            $self->register_watcher($handle, $pid, $args);
            return;
        } elsif ($command eq 'list_processes') {
            $self->list_processes($handle);
        } elsif ($command =~ /^signal:\s+(\d+)\s+(.+)/) {
            my ($pid, $message) = ($1, $2);
            $self->send_signal($handle, $pid, $message);
        } else {
            say 'Error: unrecognised command';
            $handle->push_write("Invalid command [$command]" . ${cr});
        }

        $handle->on_drain(sub { $handle->destroy(); });
    });
}

sub prepare_handler
{
    my ($fh, $host, $port) = @_;
    DEBUG && warn "Listening on $host:$port\n";
}

sub _accept_handler
{
    my $self = shift;

    return sub {
        my ($sock, $peer_host, $peer_port) = @_;

        DEBUG && warn "Accepted connection from $peer_host:$peer_port\n";
        if (! $sock) {
            warn '$sock undefined' . "\n";
            return;
        }

        $self->watch_socket($sock);
    };
}

sub start_listen
{
    my ($self, $host, $port) = @_;

    $self->{server} = tcp_server($host,
                                 $port,
                                 $self->_accept_handler(),
                                 \&prepare_handler);
}

package main;

my $host = undef;
my $port = 12345;

my $kernel = Kernel->new();
$kernel->start_listen($host, $port);

AE::cv->recv();

Read Full Post »

This is part 1 in my occasional AnyEvent series

I’ve been playing around with Plack and Twiggy recently and that motivated me to take a look at AnyEvent, the eventing library that Twiggy is built upon.

Now, it seems to me that AnyEvent is useful in a similar problem-space to POE (or Coro, on Unix at least). POE has more documentation but AnyEvent can actually use a couple of Event Loops that were implemented in C: EV and libevent which is the backbone of the hugely successful memcached. Sounds good to me.

As usual, first things first. How do you make a simple TCP server? I took a look at how Twiggy does it – the code is available in Twiggy::Server. I won’t need everything in there of course.

The Preamble

I like the way that Twiggy sets a constant called DEBUG from an environment variable. Now I can call the script like this: $ SERVER_DEBUG=1 ./ae.pl and get debugging output.

#!/usr/bin/perl

use 5.010;

use strict;
use warnings;

package Server;

use constant CTRL_D => 4;
use constant DEBUG => $ENV{SERVER_DEBUG};

use IO::Handle;
use Socket qw(IPPROTO_TCP TCP_NODELAY);
use Errno qw(EAGAIN EINTR);

use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Util qw(WSAEWOULDBLOCK);

Basic Perl Objects

The watch variables only watch while they are in scope. If we have a simple object, we can dump them into the underlying blessed hash reference to keep ‘em in scope. I’m lamenting the non-standardness of Moose here, but that’s another post.

sub new
{
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self;
}

Bottom-up or Top-down I’m never quite sure how to present my code. Hmmm…

AnyEvent::tcp_server

So, we’re assuming here that a server object will be called (with my $server Server->new()=) and then we will call $server->start_listen(...).

The example tcp_server call in the AnyEvent::Socket documentation rather unhelpfully demonstrates closing the socket the moment it has connected with a The internet is full, $host:$port. Go away! message. Oh well, maybe my examples are equally flawed. Thank goodness for Twiggy.

sub start_listen
{
    my ($self, $host, $port) = @_;

    $self->{server} = tcp_server($host,
                                 $port,
                                 $self->_accept_handler(),
                                 \&prepare_handler);
}

prepare_handler just logs a basic message on start-up. The accept handler returns a closure to maintain access to $self. The closure sets the socket options and then creates a watcher using watch_socket.

sub prepare_handler
{
    my ($fh, $host, $port) = @_;
    DEBUG && warn "Listening on $host:$port\n";
}

sub _accept_handler
{
    my $self = shift;

    return sub {
        my ($sock, $peer_host, $peer_port) = @_;

        DEBUG && warn "$sock Accepted connection from $peer_host:$peer_port\n";
        return unless $sock;

        setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1)
            or die "setsockopt(TCP_NODELAY) failed: $!";
        $sock->autoflush(1);

        # my $socket = IO::Socket::INET->new_from_fd($sock, 'r+');
        # $socket->autoflush(1);
        # $socket->blocking(0);

        $self->watch_socket($sock);
    };
}

AnyEvent IO watcher

The watcher is setup to echo whatever it received, back to the sender. If it receives EOF (sent when a telnet client hits CTRL-D), then it terminates the connection.

Now, I didn’t manage to get this working immediately. If the watcher goes out of scope, it doesn’t end up watching anything. And I originally omitted the undef $headers_io_watcher statements. As the closure wasn’t referring to the watcher variable, it went out of scope immediately. Adding them added a reference which stopped that happening. Nice, if a little subtle.

sub watch_socket
{
    my ($self, $sock) = @_;

    my $headers_io_watcher;

    $headers_io_watcher = AE::io $sock, 0, sub {
        while (defined(my $line = <$sock>)) {
            $line =~ s/\r?\n$//;
            say "Received: [$line] " . length($line) . ' ' . ord($line);

            if (length($line) == 1 and ord($line) == CTRL_D) {
                print $sock "Received EOF.  Closing connection...\r\n";
                undef $headers_io_watcher;
            } else {
                print $sock "You sent [$line]\r\n";
            }
        }

        if ($! and $! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK ) {
            undef $headers_io_watcher;
            die $!;
        } elsif (!$!) {
            undef $headers_io_watcher;
            die "client disconnected";
        }
    };
}

main()

package main;

my $host = undef;
my $port = 12345;

my $server = Server->new();
$server->start_listen($host, $port);

AE::cv->recv();

And here is the result.

$ telnet localhost 12345
Trying ::1...
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
hello
You sent [hello]
Received EOF.  Closing connection...
Connection closed by foreign host.

Read Full Post »

$ date
Tue Apr  6 20:40:38 BST 2010
$ perl -MPOSIX -le 'print "Week ",
>                         POSIX::strftime("%V", gmtime(time))'
Week 14

Perl Plack

First of all the plack links as that is what I am currently interested in. Note: Most of these links are not from the past few weeks, but they are the best articles that I have found so far on Plack.

I read Simon Cozens on PSGI and Plack several times. I don’t think I get it as well as him yet though.

I’m a lumberjaph has an article on using Plack::Middleware::ConditionalGET Plack::Middleware::ETag to return a 304 Not Modified response when requesting the same ETag twice. I like the idea of getting the Plack infrastructure to do as much of the work as possible – less [personal] coding is better.

My own post on getting started with Plack/Twiggy shows that requesting the handler (with e.g. install Plack::Handler::Twiggy) is the easiest way to get all of the dependencies. This works on Windows with Strawberry Perl. Digging a little deeper, there are a few windows specific issues I uncovered when looking into Plack Auto Restart but a few of these have been fixed since I posted.

Other Windows Web Posts

Windows really is the unloved ugly cousin in the perl world. Alias finds out that Dancer doesn’t work at all on Windows. Alexis Sukrieh followed up with a note that this will be worked on for the Dancer 1.2 release.

afoolishmanifesto talks about using the catalyst dev server on Windows / Strawberry Perl due to problems with building mod_perl. Interestingly one of the commenters suggests a Plack engine.

Finally, I’ve added acidcycles.wordpress.com to my reader. Not only is he talking about Catalyst and templating engines such as HTML::Zoom but he also mentioned building an Emacs site with Catalyst which I will be following with interest – look curiousprogrammer is (or at least was at the time of writing) the emacs featured blog on wordpress!

Read Full Post »

Directory Aliases is one of my favourite emacs packages, well, out of the ones I have written at least. It provides a way to go from an alias to a directory location using ido and dired respectively. On Linux, I can use shell aliases and the emacs daemon but for my sins, a lot of my time is spent developing on Windows and there it is invaluable. As I find the various Windows shells are lacking it is nice to an alternative interface to the OS – emacs.

alias realias='$EDITOR ~/.aliases; source ~/.aliases'

Inspired by chromatic’s post mentioning realias (attributed to Damian Conway) I added a couple of features to directory aliases. The first is the ability to open a regular file in addition to the directory. The second is the ability to reload the aliases so you have access to them immediately after adding them.

Future plans include a facility to add an alias with a keystroke while visiting a file (maybe I should be using bookmarks instead… but I like ido too much).

(require 'ido)
(require 'dired)

(defconst *home* "c:/home/jared")
(defconst *packages* "c:/packages")

(defconst *file:dir-aliases* (concat *elisp-dir* "dir-aliases.el"))

(defsubst home (path) (concat *home* path))
(defsubst packages (path) (concat *packages* path))

The preamble has some convenience functions for referring to commonly used areas.

(defconst *file-aliases*
  (list (cons "dir-aliases" *file:dir-aliases*)
        ...))

(defconst *dired-aliases*
  (list (cons "project" (home "/project"))
        (cons "curious" (home "/websites/curious"))
        (cons "plack" (home "/plack-tests"))
        (cons "site-lisp" (packages "/emacs/site-lisp"))
        ...))

I main separate alists for file aliases and dired aliases.

(defun my-open-alias (aliases fn &optional alias)
  (interactive)
  (unless alias
    (setq alias
          (ido-completing-read "Alias: "
                               (mapcar (lambda (e) (car e)) aliases)
                               nil t)))
  (if (and (stringp alias) (> (length alias) 0 ))
      (let ((pair (assoc alias aliases)))
        (if pair
            (funcall fn (cdr pair))
          (error "Invalid alias %s" alias)))
    (error "Invalid alias %s" alias)))

The main my-open-alias function reads in the alias with ido and then applies the passed in function.

(defun file-open-alias (&optional alias)
  (interactive)
  (my-open-alias *file-aliases* #'find-file alias))

(defun dired-open-alias (&optional alias)
  (interactive)
  (my-open-alias *dired-aliases* #'dired alias))

(defun reload-aliases ()
  (interactive)
  (load *file:dir-aliases*))

More convenience functions using #'find-file and #'dired and the alias reloader I mentioned earlier.

(defvar f2-prefix-map nil)
(setq f2-prefix-map (make-sparse-keymap))

(global-set-key [f2] f2-prefix-map)
(global-set-key (kbd " d") 'dired-open-alias)
(global-set-key (kbd " f") 'file-open-alias)

(provide 'dir-aliases)

Maybe dir-aliases isn’t the best name anymore.

Read Full Post »

Follow

Get every new post delivered to your Inbox.