dgsmon

   1 #! /usr/bin/perl -w
   2
   3 my $version = "v1.1";
   4
   5 ###############################################################################
   6 # Monitors DGS for new games
   7
   8 =head1 NAME
   9
  10  dgsmon - Dragon Go Server Monitor
  11
  12 =head1 SYNOPSIS
  13
  14  dgsmon [-fchart]
  15
  16 =head1 DESCRIPTION
  17
  18 B<dgsmon> monitors Dragon Go Server
  19 (http://www.dragongoserver.net) for you to check whether
  20 it's your turn to move on one or more games. For each game,
  21 it will print out the name of the opponent.
  22
  23 =cut
  24
  25 use warnings;
  26 use strict;
  27 use HTTP::Cookies;
  28 use LWP::UserAgent;
  29 use HTML::TreeBuilder;
  30 use HTML::Form;
  31
  32 use Pod::Usage;
  33
  34 ###############################################################################
  35 # Constants
  36 my $cookie_file = "$ENV{HOME}/.dgsmon.cookies";
  37 my $config_file = "$ENV{HOME}/.dgsmonrc";
  38
  39 ###############################################################################
  40 # Variables
  41 my ($cookie_jar, $request, $response, $output_format);
  42
  43 my (%config, $verbose);
  44
  45 ###############################################################################
  46
  47 =head1 OPTIONS
  48
  49 =over 4
  50
  51 =item I<-fmon>
  52
  53 Produce output in the format used by GKrellm FMonitor[1].
  54 You can call B<dgsmon> regularly with this option from a
  55 crontab, direct the output to a file, and set Gkrellm to
  56 display the information.
  57
  58 A crontab entry that works every minute would look like:
  59
  60  * * * * * $HOME/bin/dgsmon -fmon > $HOME/.dgsmon.output
  61
  62 Then you would configure FMonitor to use
  63 $HOME/.dgsmon.output.
  64
  65 =cut
  66
  67 $output_format = 'NORMAL';
  68 $verbose = 0;
  69
  70 foreach my $arg (@ARGV) {
  71     if ($arg =~ /fmon/) {
  72         $output_format = 'FMON';
  73         next;
  74     }
  75     if ($arg =~ /verbose/) {
  76         $verbose = 1;
  77         next;
  78     }
  79     pod2usage(-verbose=>2) if @ARGV;
  80 }
  81
  82 =back
  83
  84 =cut
  85
  86 ###############################################################################
  87 # Lecture du fichier de config
  88
  89
  90 =head1 FILES
  91
  92 =over 4
  93
  94 =item $HOME/.dgsmonrc
  95
  96 Upon startup, the file $HOME/.dgsmonrc is checked for
  97 authentication information. This file is  simple "key=value"
  98 file, one value per line, and must define a key C<username>
  99 containing your user identifier, and a ke C<passwd>
 100 containing your password. To prevent other users from
 101 accessing your login information, thie file must only be
 102 accessible by you.  B<dgsmon> will refuse to work if its
 103 access mode is not 600.
 104
 105 Example:
 106
 107  username=whiterabbit
 108  passwd=wonderland
 109
 110 =cut
 111
 112 {
 113     die "$config_file: Unable to read\n" unless -r $config_file;
 114     my $mode = (stat $config_file)[2];
 115     die "$config_file must be 0600\n" if (($mode&0777) != 0600);
 116     open my $fh, $config_file or die "$config_file: $!\n";
 117     while (<$fh>) {
 118         my ($key, $value) = /(\w+)=(.*)/;
 119         die "illegal config line: $_\n" unless defined $key
 120             and defined $value;
 121         $config{$key} = $value;
 122     }
 123 }
 124
 125 ###############################################################################
 126
 127 =item $HOME/.dgsmon.cookies
 128
 129 This file is managed by B<dgsmon>. It is used to store the
 130 login cookies that Dragon Go Server sends back, so B<dgsmon>
 131 can just re-use them if possible. This saves authenticating
 132 yourself each time. To prevent other users from accessing
 133 your cookie information, which would let them connect using
 134 your account, this file must only be accessible by you.
 135 B<dgsmon> will refuse to work if its access mode is
 136 not 600.
 137
 138 =cut
 139
 140 # Check if we've got cookies
 141 if (-e $cookie_file) {
 142     my $mode = (stat $cookie_file)[2];
 143     die "$cookie_file must be 0600\n" if (($mode&0777) != 0600);
 144
 145     $cookie_jar = HTTP::Cookies->new;
 146     $cookie_jar->load($cookie_file);
 147     die "$cookie_file: $!\n" unless defined $cookie_jar;
 148 }
 149
 150 my $user_agent = LWP::UserAgent->new;
 151
 152 # Try to log in with the current cookies
 153 $user_agent->cookie_jar($cookie_jar);
 154 $request = new HTTP::Request(
 155     GET => "http://www.dragongoserver.net/status.php"
 156 );
 157 $response = $user_agent->request($request);
 158
 159 my $logged_in = !($response->content =~ /have to be logged in/);
 160
 161 ###############################################################################
 162 # Log in if required
 163 if (!$logged_in) {
 164     warn "loggin in...\n" if $verbose;
 165
 166 # Log in
 167     $response = $user_agent->request(
 168         HTTP::Request->new(
 169             GET => "http://www.dragongoserver.net/index.php"
 170         ));
 171
 172     die "Load login page failed: ".$response->status_line."\n" unless $response->is_success;
 173
 174     warn "login page loaded\n" if $verbose;
 175
 176     my $form = HTML::Form->parse($response);
 177     die "No form on login page\n" unless defined $form;
 178
 179     $form->value("userid", $config{username});
 180     $form->value("passwd", $config{passwd});
 181
 182     print "userid: ".$form->value("userid")."\n" if $verbose;
 183     print "passwd: ".$form->value("passwd")."\n" if $verbose;
 184
 185     $request = $form->click("login");
 186     die "clicking form failed\n" unless defined $request;
 187
 188     warn "filled form\n" if $verbose;
 189
 190     $response = $user_agent->request($request);
 191
 192     warn "form response received\n" if $verbose;
 193
 194 # Get login cookies
 195     $cookie_jar = HTTP::Cookies->new;
 196     $cookie_jar->extract_cookies($response);
 197     my $old_umask = umask(0077);
 198     $cookie_jar->save($cookie_file);
 199     umask($old_umask);
 200     $user_agent->cookie_jar($cookie_jar);
 201
 202     warn "loading status page\n" if $verbose;
 203 # Finally, get the status page
 204     $request = new HTTP::Request(
 205         GET => $response->header('location')
 206     );
 207
 208     $response = $user_agent->request($request);
 209 }
 210
 211 ###############################################################################
 212 # At this stage, $response should contain the main page
 213
 214
 215 # Get all the links containing 'game.php'
 216 my $tree = HTML::TreeBuilder->new();
 217 $tree->parse($response->content);
 218 $tree->eof;
 219
 220 my @out;
 221 foreach my $link (
 222     $tree->look_down(   # !
 223     '_tag', 'a',
 224     sub {
 225         my $href = $_[0]->attr('href');
 226         return unless defined $href;
 227         return unless $href =~ /game\.php/;
 228     }
 229     )
 230 ) {
 231     push @out, $link;
 232 }
 233
 234 if ($output_format eq 'FMON') {
 235     if (@out == 0) {
 236         print "none::\n";
 237     }
 238 }
 239
 240 foreach my $game (@out) {
 241     my @elems = $game->parent->parent->content_list;
 242     my ($board, $sgf ,$player, $color, $size, $handi, $komi) =
 243     map { $_->as_text; } @elems;
 244     $board =~ s/\D//g;
 245     if ($output_format eq 'FMON') {
 246         print "${player}::\n";
 247     } else {
 248         print "[$board] $player ($size x $size, handi $handi komi $komi)\n";
 249     }
 250 }
 251
 252 =head1 LINKS
 253
 254 [1] The FMonitor plugin is available from
 255 http://kmlinux.fjfi.cvut.cz/~makovick/gkrellm/index.html.
 256
 257 =head1 HISTORY
 258
 259 v1.1: Error message when login fails.
 260
 261 v1.0: First release. Works for me(tm).
 262
 263 =head1 LICENSE
 264
 265 This program is free software; you may redistribute it
 266 and/or modify it under the same terms as Perl itself.
 267
 268 =head1 AUTHOR
 269
 270 Yves "WhiteRabbit" Rutschle -- Challenge me on DGS! ;)
 271
 272 Send comments and bug reports to dgs@rutschle.net.
 273
 274 =cut