client.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (c) 2013 Michel Ketterle, Steven Schubiger
   4 #
   5 # This file is part of distdns.
   6 #
   7 # distdns is free software: you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation, either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # distdns is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with distdns.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 use strict;
  21 use warnings;
  22 use constant false => 0;
  23
  24 use Config::Tiny;
  25 use Digest::MD5 qw(md5_hex);
  26 use Fcntl ':flock';
  27 use File::Spec::Functions qw(rel2abs);
  28 use Getopt::Long qw(:config no_auto_abbrev no_ignore_case);
  29 use JSON qw(decode_json);
  30 use LWP::UserAgent;
  31 use Sys::Hostname qw(hostname);
  32 use Tie::File;
  33
  34 my $VERSION = '0.04';
  35
  36 #-----------------------
  37 # Start of configuration
  38 #-----------------------
  39
  40 my $config_file  = 'dynuser.conf';
  41 my $hosts_file   = 'hosts';
  42 my $session_file = 'session.dat';
  43 my $server_url   = 'http://refcnt.org/~sts/cgi-bin/ketterle/server.cgi';
  44
  45 #---------------------
  46 # End of configuration
  47 #---------------------
  48
  49 sub usage
  50 {
  51     print <<"USAGE";
  52 Usage: $0
  53     -d, --debug    server debugging
  54     -h, --help     this help screen
  55     -i, --init     initialize session data
  56 USAGE
  57     exit;
  58 }
  59
  60 my %opts;
  61 GetOptions(\%opts, qw(d|debug h|help i|init)) or usage();
  62 usage() if $opts{h};
  63
  64 $config_file  = rel2abs($config_file);
  65 $hosts_file   = rel2abs($hosts_file);
  66 $session_file = rel2abs($session_file);
  67
  68 my $save_session = sub
  69 {
  70     my ($session) = @_;
  71
  72     open(my $fh, '>', $session_file) or die "Cannot open client-side $session_file for writing: $!\n";
  73     print {$fh} "$session\n";
  74     close($fh);
  75 };
  76
  77 my $get_session = sub
  78 {
  79     open(my $fh, '<', $session_file) or die "Cannot open client-side $session_file for reading: $!\nPerhaps try running --init\n";
  80     my $session = do { local $/; <$fh> };
  81     chomp $session;
  82     close($fh);
  83
  84     return $session;
  85 };
  86
  87 my $session = $opts{i} ? substr(md5_hex(md5_hex(time() . {} . rand() . $$)), 0, 32) : $get_session->();
  88
  89 my $config = Config::Tiny->new;
  90    $config = Config::Tiny->read($config_file);
  91
  92 my ($netz, $name) = @{$config->{data}}{qw(netz name)};
  93
  94 die "$0: Network and/or name not set in $config_file\n" unless defined $netz && defined $name;
  95
  96 my %params = (
  97     netz    => $netz,
  98     pc      => hostname(),
  99     name    => $name,
 100     debug   => $opts{d} || false,
 101     init    => $opts{i} || false,
 102     session => $session,
 103 );
 104
 105 my $ua = LWP::UserAgent->new;
 106
 107 my $response = $ua->post($server_url, \%params);
 108
 109 if ($response->is_success) {
 110     my $data;
 111
 112     eval {
 113         $data = decode_json($response->decoded_content);
 114     } or exit;
 115
 116     die "$0: $data->{error}" if defined $data->{error};
 117
 118     $save_session->($session) if $opts{i};
 119
 120     my %list;
 121     foreach my $entry (@{$data->{entries}}) {
 122         my $host = "$entry->{ip}\t" . join '.', @$entry{qw(name pc netz)};
 123         push @{$list{$entry->{netz}}}, $host;
 124     }
 125
 126     my $o = tie my @hosts, 'Tie::File', $hosts_file or die "$0: Cannot tie $hosts_file: $!\n";
 127     $o->flock(LOCK_EX);
 128
 129     foreach my $network (keys %list) {
 130         my %indexes;
 131         for (my $i = 0; $i < @hosts; $i++) {
 132             if ($hosts[$i] =~ /^\#$network\#$/i) {
 133                 $indexes{start} = $i;
 134             }
 135             elsif (exists $indexes{start} && $hosts[$i] =~ /^\#\/$network\#$/i) {
 136                 $indexes{end} = $i;
 137                 my $count = ($indexes{end} - $indexes{start} > 1)
 138                   ? $indexes{end} - $indexes{start} - 1
 139                   : 0;
 140                 splice @hosts, $indexes{start} + 1, $count, @{$list{$network}};
 141                 last;
 142             }
 143         }
 144     }
 145
 146     undef $o;
 147     untie @hosts;
 148 }
 149 else {
 150     warn $response->status_line, "\n";
 151 }