--- /dev/null
+#! /usr/bin/perl -w
+
+my $version = "v1.1";
+
+###############################################################################
+# Monitors DGS for new games
+
+=head1 NAME
+
+ dgsmon - Dragon Go Server Monitor
+
+=head1 SYNOPSIS
+
+ dgsmon [-fchart]
+
+=head1 DESCRIPTION
+
+B<dgsmon> monitors Dragon Go Server
+(http://www.dragongoserver.net) for you to check whether
+it's your turn to move on one or more games. For each game,
+it will print out the name of the opponent.
+
+=cut
+
+use warnings;
+use strict;
+use HTTP::Cookies;
+use LWP::UserAgent;
+use HTML::TreeBuilder;
+use HTML::Form;
+
+use Pod::Usage;
+
+###############################################################################
+# Constants
+my $cookie_file = "$ENV{HOME}/.dgsmon.cookies";
+my $config_file = "$ENV{HOME}/.dgsmonrc";
+
+###############################################################################
+# Variables
+my ($cookie_jar, $request, $response, $output_format);
+
+my (%config, $verbose);
+
+###############################################################################
+
+=head1 OPTIONS
+
+=over 4
+
+=item I<-fmon>
+
+Produce output in the format used by GKrellm FMonitor[1].
+You can call B<dgsmon> regularly with this option from a
+crontab, direct the output to a file, and set Gkrellm to
+display the information.
+
+A crontab entry that works every minute would look like:
+
+ * * * * * $HOME/bin/dgsmon -fmon > $HOME/.dgsmon.output
+
+Then you would configure FMonitor to use
+$HOME/.dgsmon.output.
+
+=cut
+
+$output_format = 'NORMAL';
+$verbose = 0;
+
+foreach my $arg (@ARGV) {
+ if ($arg =~ /fmon/) {
+ $output_format = 'FMON';
+ next;
+ }
+ if ($arg =~ /verbose/) {
+ $verbose = 1;
+ next;
+ }
+ pod2usage(-verbose=>2) if @ARGV;
+}
+
+=back
+
+=cut
+
+###############################################################################
+# Lecture du fichier de config
+
+
+=head1 FILES
+
+=over 4
+
+=item $HOME/.dgsmonrc
+
+Upon startup, the file $HOME/.dgsmonrc is checked for
+authentication information. This file is simple "key=value"
+file, one value per line, and must define a key C<username>
+containing your user identifier, and a ke C<passwd>
+containing your password. To prevent other users from
+accessing your login information, thie file must only be
+accessible by you. B<dgsmon> will refuse to work if its
+access mode is not 600.
+
+Example:
+
+ username=whiterabbit
+ passwd=wonderland
+
+=cut
+
+{
+ die "$config_file: Unable to read\n" unless -r $config_file;
+ my $mode = (stat $config_file)[2];
+ die "$config_file must be 0600\n" if (($mode&0777) != 0600);
+ open my $fh, $config_file or die "$config_file: $!\n";
+ while (<$fh>) {
+ my ($key, $value) = /(\w+)=(.*)/;
+ die "illegal config line: $_\n" unless defined $key
+ and defined $value;
+ $config{$key} = $value;
+ }
+}
+
+###############################################################################
+
+=item $HOME/.dgsmon.cookies
+
+This file is managed by B<dgsmon>. It is used to store the
+login cookies that Dragon Go Server sends back, so B<dgsmon>
+can just re-use them if possible. This saves authenticating
+yourself each time. To prevent other users from accessing
+your cookie information, which would let them connect using
+your account, this file must only be accessible by you.
+B<dgsmon> will refuse to work if its access mode is
+not 600.
+
+=cut
+
+# Check if we've got cookies
+if (-e $cookie_file) {
+ my $mode = (stat $cookie_file)[2];
+ die "$cookie_file must be 0600\n" if (($mode&0777) != 0600);
+
+ $cookie_jar = HTTP::Cookies->new;
+ $cookie_jar->load($cookie_file);
+ die "$cookie_file: $!\n" unless defined $cookie_jar;
+}
+
+my $user_agent = LWP::UserAgent->new;
+
+# Try to log in with the current cookies
+$user_agent->cookie_jar($cookie_jar);
+$request = new HTTP::Request(
+ GET => "http://www.dragongoserver.net/status.php"
+);
+$response = $user_agent->request($request);
+
+my $logged_in = !($response->content =~ /have to be logged in/);
+
+###############################################################################
+# Log in if required
+if (!$logged_in) {
+ warn "loggin in...\n" if $verbose;
+
+# Log in
+ $response = $user_agent->request(
+ HTTP::Request->new(
+ GET => "http://www.dragongoserver.net/index.php"
+ ));
+
+ die "Load login page failed: ".$response->status_line."\n" unless $response->is_success;
+
+ warn "login page loaded\n" if $verbose;
+
+ my $form = HTML::Form->parse($response);
+ die "No form on login page\n" unless defined $form;
+
+ $form->value("userid", $config{username});
+ $form->value("passwd", $config{passwd});
+
+ print "userid: ".$form->value("userid")."\n" if $verbose;
+ print "passwd: ".$form->value("passwd")."\n" if $verbose;
+
+ $request = $form->click("login");
+ die "clicking form failed\n" unless defined $request;
+
+ warn "filled form\n" if $verbose;
+
+ $response = $user_agent->request($request);
+
+ warn "form response received\n" if $verbose;
+
+# Get login cookies
+ $cookie_jar = HTTP::Cookies->new;
+ $cookie_jar->extract_cookies($response);
+ my $old_umask = umask(0077);
+ $cookie_jar->save($cookie_file);
+ umask($old_umask);
+ $user_agent->cookie_jar($cookie_jar);
+
+ warn "loading status page\n" if $verbose;
+# Finally, get the status page
+ $request = new HTTP::Request(
+ GET => $response->header('location')
+ );
+
+ $response = $user_agent->request($request);
+}
+
+###############################################################################
+# At this stage, $response should contain the main page
+
+
+# Get all the links containing 'game.php'
+my $tree = HTML::TreeBuilder->new();
+$tree->parse($response->content);
+$tree->eof;
+
+my @out;
+foreach my $link (
+ $tree->look_down( # !
+ '_tag', 'a',
+ sub {
+ my $href = $_[0]->attr('href');
+ return unless defined $href;
+ return unless $href =~ /game\.php/;
+ }
+ )
+) {
+ push @out, $link;
+}
+
+if ($output_format eq 'FMON') {
+ if (@out == 0) {
+ print "none::\n";
+ }
+}
+
+foreach my $game (@out) {
+ my @elems = $game->parent->parent->content_list;
+ my ($board, $sgf ,$player, $color, $size, $handi, $komi) =
+ map { $_->as_text; } @elems;
+ $board =~ s/\D//g;
+ if ($output_format eq 'FMON') {
+ print "${player}::\n";
+ } else {
+ print "[$board] $player ($size x $size, handi $handi komi $komi)\n";
+ }
+}
+
+=head1 LINKS
+
+[1] The FMonitor plugin is available from
+http://kmlinux.fjfi.cvut.cz/~makovick/gkrellm/index.html.
+
+=head1 HISTORY
+
+v1.1: Error message when login fails.
+
+v1.0: First release. Works for me(tm).
+
+=head1 LICENSE
+
+This program is free software; you may redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Yves "WhiteRabbit" Rutschle -- Challenge me on DGS! ;)
+
+Send comments and bug reports to dgs@rutschle.net.
+
+=cut
projects / bin.git / commitdiff