#!/usr/bin/perl -w
use strict;
use Carp;
use Danga::Socket;
use Data::YUID::Generator;
use Getopt::Long;
use IO::Socket::INET;
use POSIX ();
use constant DEFAULT_PORT => 9001;
our $Debug = 0;
our $Generator;
our %Stats;
GetOptions(
'daemon|d' => \my($daemonize),
'port|p=i' => \my($port),
'hostid|h=s' => \my($host_id),
'debug' => \$Debug,
);
$port ||= DEFAULT_PORT;
$Generator = Data::YUID::Generator->new($host_id);
$Stats{started} = time;
daemonize() if $daemonize;
sub debug {
print STDERR join('', @_), "\n" if $Debug;
}
my $server = IO::Socket::INET->new(
LocalPort => $port,
Type => SOCK_STREAM,
Proto => 'tcp',
Blocking => 0,
Reuse => 1,
Listen => 10
) or die "Error creating socket: $@";
my $accept_handler = sub {
my $sock = $server->accept or return;
debug "Listen child making a client for " . fileno($sock);
$sock->blocking(0);
my $client = Data::YUID::Server::Client->new($sock);
$client->watch_read(1);
};
Data::YUID::Server::Client->OtherFds(fileno($server) => $accept_handler);
Data::YUID::Server::Client->EventLoop;
sub daemonize {
my $pid;
## Fork and exit parent.
$pid = fork() and exit 0;
## Detach from the terminal.
POSIX::setsid()
or croak "Cannot detach from controlling terminal";
## Prevent possibility of acquiring a controlling terminal.
$SIG{'HUP'} = 'IGNORE';
$pid = fork() and exit 0;
## Change working directory and file mask.
chdir '/' or croak "Can't chdir to /: $!";
umask 0;
## Detach open file descriptors, and re-attach to /dev/null.
close STDIN;
close STDOUT;
close STDERR;
open STDIN, '+>/dev/null';
open STDOUT, '+>&STDIN';
open STDERR, '+>&STDIN';
}
package Data::YUID::Server::Client;
use base qw( Danga::Socket );
use URI::Escape;
use fields qw( read_buf );
sub new {
my Data::YUID::Server::Client $client = shift;
$client = fields::new($client) unless ref $client;
$client->SUPER::new(@_);
$client->{read_buf} = '';
$client;
}
sub event_read {
my Data::YUID::Server::Client $client = shift;
my $bref = $client->read(1024);
return $client->close unless defined $bref;
$client->{read_buf} .= $$bref;
if ($client->{read_buf} =~ s/^(.+?)\r?\n//) {
my $line = $1;
$client->process_line($line);
}
}
sub process_line {
my Data::YUID::Server::Client $client = shift;
my($line) = @_;
if ($line =~ /^(\w+)\s*(.*)/) {
my($cmd, $args) = ($1, $2);
$cmd = lc $cmd;
if (my $meth = $client->can('CMD_' . $cmd)) {
$meth->($client, decode_args($args));
return 1;
}
}
return $client->err_line('unknown_command');
}
sub CMD_getid {
my Data::YUID::Server::Client $client = shift;
my($args) = @_;
my $id = $Generator->get_id($args->{ns})
or return $client->err_line('too_many');
$Stats{count}{total}++;
return $client->ok_line({ id => $id });
}
sub CMD_stats {
my Data::YUID::Server::Client $client = shift;
return $client->ok_line({
total_given => $Stats{count}{total} || 0,
started => $Stats{started},
});
}
sub CMD_ping {
my Data::YUID::Server::Client $client = shift;
return $client->ok_line;
}
sub CMD_shutdown {
exit 0;
}
sub ok_line {
my Data::YUID::Server::Client $client = shift;
my($args) = @_;
my $argline = join ' ',
map uri_escape($_) . '=' . uri_escape($args->{$_}),
keys %$args;
$client->write("OK $argline\r\n");
return 1;
}
sub err_line {
my Data::YUID::Server::Client $client = shift;
my($err) = @_;
$client->write("ERR $err\r\n");
return 0;
}
sub decode_args {
my($str) = @_;
my $args;
for my $pair (split /\s+/, $str) {
my($name, $val) = split /=/, $pair;
for ($name, $val) {
$_ = uri_unescape($_);
}
$args->{$name} = $val;
}
$args;
}
1;
__END__
=head1 NAME
yuidd - YUID Distributed ID server
=head1 SYNOPSIS
yuidd [--port <port>] [--hostid <hostid>]
=head1 DESCRIPTION
I<yuidd> implements the server portion of the YUID client/server protocol.
=head1 USAGE
The options are:
=over 4
=item --hostid <host-id>
Specifies the unique host ID of the machine running this server instance.
This is equivalent to the use of a MAC address in Type-1 UUIDs.
This argument is optional, but highly recommended. If you don't provide a
host ID, an ID will be randomly generated, but this leaves the potential
for collisions.
=item --port <port>
Specifies the port for the server to listen on.
This argument is optional. If not provided, I<yuidd> will listen on port
C<9001>.
=item --daemon
Specifies that the server should be daemonized to run in the background.
This argument is optional. If not provided, the server will run in the
foreground.
=item --debug
Turns on debugging information.
This argument is optional. If not provided, debugging is off.
=back
=head1 AUTHOR & COPYRIGHT
Please see the I<Data::YUID> manpage for author, copyright, and license
information.
=cut