diff --git a/README.md b/README.md
index 3ca7e6f..4912939 100644
--- a/README.md
+++ b/README.md
@@ -35,6 +35,12 @@ Once you've got all that, just run `plackup` to start a development server. You
You can deploy cyberman however you want, using Plack. Just make sure you pass `-E production` - this disables detailed error pages which could be a security risk, and tones down the logging.
+## WHOIS server
+
+The WHOIS server is written in Perl 6 (what do you think I am, a luddite?!) so you need to install that first, along with Panda, a package manager. Then, install the dependencies for the WHOIS server: `cat whoissrv/DEPENDENCIES | xargs -n 1 panda install`. Edit the values in the `whoissrv` section of `config.yml` and then start the server as root.
+
+The WHOIS server is not supported on Windows at this time.
+
## Questions, fan mail, etc
Feel free to join `#cyb` on `irc.cyberia.is`!
diff --git a/config.yml b/config.yml
index 0580f30..4bc5db8 100644
--- a/config.yml
+++ b/config.yml
@@ -48,3 +48,13 @@ mail:
# Currently, the local MTA is used and there's no config option
from: 'cybnic@uptime.party'
baseurl: 'http://opennic.cyb'
+
+whoissrv:
+ # Only required if whoissrv is going to be run
+ bind: "0.0.0.0"
+ port: 43
+ logging: 1
+ motdfile: "motd.txt"
+ drop-uid: 999
+ drop-gid: 999
+ registrar-urls: "http://opennic.cyb, https://cyb.uptime.party"
diff --git a/views/admin/domains.tt b/views/admin/domains.tt
index 954d981..35d5130 100644
--- a/views/admin/domains.tt
+++ b/views/admin/domains.tt
@@ -18,7 +18,7 @@
<% FOREACH d IN domains %>
- <% d.name | html_entity %>.cyb
+ <% d.name | html_entity %>.<% vars.config.tld %>
|
[ show ]
diff --git a/whoissrv/DEPENDENCIES b/whoissrv/DEPENDENCIES
new file mode 100644
index 0000000..8230912
--- /dev/null
+++ b/whoissrv/DEPENDENCIES
@@ -0,0 +1,3 @@
+POSIX
+YAMLish
+DBIish
diff --git a/whoissrv/motd.txt b/whoissrv/motd.txt
new file mode 100644
index 0000000..9bc1ca1
--- /dev/null
+++ b/whoissrv/motd.txt
@@ -0,0 +1,6 @@
+
+Welcome to the cybNIC registry!
+The following information is presented in the hopes that it will be useful,
+but cybNIC makes ABSOLUTELY NO GUARANTEE as to its accuracy.
+
+Queries made to this service may be logged. IP addresses will not be logged.
diff --git a/whoissrv/whoissrv.pl6 b/whoissrv/whoissrv.pl6
new file mode 100755
index 0000000..bff0a5c
--- /dev/null
+++ b/whoissrv/whoissrv.pl6
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl6
+use v6.c;
+use POSIX;
+use YAMLish;
+use DBIish;
+
+my $yamldata = slurp "../config.yml";
+my $config = load-yaml($yamldata);
+
+my $listener = IO::Socket::Async.listen($config.{'whoissrv'}.{'bind'}, $config.{'whoissrv'}.{'port'});
+
+my $motd = slurp $config.{"whoissrv"}.{"motdfile"};
+
+my $dbh = connect-db();
+
+$listener.tap( -> $conn {
+ log("New connection");
+ $conn.Supply.tap( -> $in {
+ my $q = $in.chomp;
+ log "Query: $q";
+ await $conn.write: ($motd~"\n").encode("utf-8");
+
+ my $tld = $config.{"tld"};
+ if ($q !~~ m/\.$tld$/) {
+ await $conn.write: "This WHOIS server does not provide data for that TLD.\n".encode("utf-8");
+ log("Data not provided; connection closed");
+ $conn.close;
+ next;
+ }
+ $q ~~ s/\.$tld$//;
+ $q = $q.lc;
+
+ my $sth = $dbh.prepare("select * from domain where name = ?");
+ $sth.execute($q);
+ my $data = $sth.row(:hash);
+
+ if (!$data) {
+ await $conn.write: "$q.$tld is not recognised by this WHOIS server.\n".encode("utf-8");
+ log("Domain not known; connection closed");
+ $conn.close;
+ next;
+ }
+
+ my $regdate = DateTime.new($data.{"since"});
+ my $regurl = $config.{"whoissrv"}.{"registrar-urls"};
+
+ await $conn.write: qq:heredoc/end/.encode("UTF-8");
+ Domain: $q.$tld
+ Domain Registered: $regdate
+ Domain Updated: < data currently unavailable >
+ Domain Expires: < data currently unavailable >
+ Domain Status: ACTIVE
+ Registrar URL(s): $regurl
+
+ Registrant Name: < withheld >
+ Registrant Email: < withheld >
+ end
+
+ $conn.close;
+ } );
+} );
+
+drop();
+
+await Promise.new;
+
+sub log ($msg) {
+ return 1 unless $config.{'whoissrv'}.{'logging'};
+ my $stamp = DateTime.now(formatter => { sprintf "[%04d-%02d-%02d %02d:%02d]", .year, .month, .day, .hour, .minute });
+ say "$stamp $msg";
+ return 1;
+}
+
+sub drop {
+ log("Dropping priviliges: uid=" ~ $config.{'whoissrv'}.{'drop-uid'} ~ ", gid=" ~ $config.{'whoissrv'}.{'drop-gid'});
+ setuid($config.{'whoissrv'}.{'drop-uid'});
+ setgid($config.{'whoissrv'}.{'drop-gid'});
+}
+
+sub connect-db {
+ my $dbtype = $config.{"plugins"}.{"Database"}.{"driver"};
+ die "Unsupported database type: $dbtype" unless $dbtype eq "SQLite";
+
+ my $dbh = DBIish.connect($dbtype, database => "../" ~ $config.{"plugins"}.{"Database"}.{"dbname"});
+ return $dbh;
+}
|