gdipc.pl

动态域名解决方案。类似windows下的花生壳。代码用perl编写

#!/usr/bin/perl
#####################################################
# gdipc.pl
#
# This is the GnuDIP command line client.
#
# See COPYING for licensing information
#
# Derived from GnuDIP 2.1.2 written by:
#
#   Mike Machado
#
#####################################################

# locate ourselves
use FindBin;
use lib "$FindBin::Bin/../lib";

# PERL packages and options
use strict;
use Socket;
use Getopt::Std;

# try for compiled MD5, otherwise use pure Perl
BEGIN {
  eval {
    require Digest::MD5;
    import  Digest::MD5 qw(md5_hex)
  };
  if ($@) { # no Digest::MD5
    require Digest::Perl::MD5;
    import  Digest::Perl::MD5 qw(md5_hex)
  }             
}

# suffix for config file
my $cfgsuff = '';

# get program name
my $pgm = $0;
if ($pgm =~ /^.*\/(.+?)$/) {
  $pgm = $1;
}

# process command line
sub usage {
  print STDOUT <<EOQ;
usage: $pgm \\
usage:   { -h | -v | -i [ -r] | [ -f configfile ] [ -c | -r | \\
usage:       [ -o outfile | -a appendfile | -l logfile ] \\
usage:       [ -g sendport:recvport ] [ -d repeatseconds] \\
usage:       [ -w waitseconds] [ -q "addressquerycommand" ] ] \\
usage:       [ -x "addresschangedcommand" ] }
usage: With no arguments, update server if address changed or time
usage: expired.
usage: -h: Print this usage message.
usage: -v: Show version information.
usage: -i: Prompt and read standard input rather than a configuration
usage:     file.
usage: -f: Specify a particular configuration file.
usage:     This will otherwise be .GnuDIP2$cfgsuff in the directory
usage:     specified by the HOME environment variable, or gdipc.conf$cfgsuff
usage:     in the directory of the binary if HOME is not set.
usage: -c: Specify contents to write to configuration file.
usage: -r: Send an offline request to the server to remove your DNS hostname.
usage: -d: Run as a daemon. Perform client action immediately and then every
usage:     "repeatseconds" seconds.
usage: -o: Specify log file to overwrite on each run with output from script.
usage: -a: Specify log file to append on each run with all output from script.
usage: -l: Specify log file for daemon mode. Overwrite on first run, then
usage:     append.
usage: -w: Timeout in seconds when waiting for address validation packet.
usage:     Defaults to 1 second. Decimal point and fraction (e.g. "0.5") is
usage:     allowed.
usage: -g: Client is behind a gateway. Request GnuDIP server to register
usage:     address it sees connection from, and pass it back in response.
usage:     Specify port to send address validation packet to and port gateway
usage:     will forward it to.
usage: -q: Command to invoke to determine IP address to report to GnuDIP
usage:     server. Command must write address to standard output. When used
usage:     with -g, address is sent to server.
usage: -x: Command to invoke if address changed. This command can be used to
usage:     to take any actions required when the address changes. All
usage:     validated addresses are passed as arguments.
EOQ
  exit;
}
use vars qw($opt_h $opt_v $opt_f $opt_i $opt_c $opt_r $opt_x);
use vars qw($opt_a $opt_o $opt_l $opt_g $opt_d $opt_w $opt_q);
if (!getopts('hvicrf:o:a:l:g:d:w:x:q:')) {
  usage();
}
if (@ARGV ne 0) {
  usage();
}

# redirect output?
my $logfile;
if ($opt_l) {
  close STDOUT;
  open(STDOUT, ">$opt_l");
  close STDERR;
  open(STDERR, ">&STDOUT");
} elsif ($opt_a) {
  close STDOUT;
  open(STDOUT, ">>$opt_a");
  close STDERR;
  open(STDERR, ">&STDOUT");
} elsif ($opt_o) {
  close STDOUT;
  open(STDOUT, ">$opt_o");
  close STDERR;
  open(STDERR, ">&STDOUT");
}

# auto flush all output
select(STDERR);
$| = 1;
select(STDOUT);
$| = 1;

# asking for help?
if ($opt_h) {
  usage();
}

# asking for version?
if ($opt_v) {
  print "This is $pgm: Version 2.3\n";
  exit;
}

# default port for address validation
my $sendport;
my $recvport = 0;

# behind gateway?
if ($opt_g) {
  if ($opt_g =~ /^([0-9]*)\:([0-9]*)$/) {
    $sendport = $1;
    $recvport = $2;
  } else {
    print "Invalid send/receive port specification for -g option\n";
    usage();
  }
}

# timeout interval
$opt_w = 1 if ! $opt_w;

#interactive mode?
if ($opt_i) {
  interactive();
  exit;
}

# get config file name
my $configfile = '';
if ($opt_f) {
  $configfile = $opt_f;
} elsif($ENV{'HOME'}) {
  $configfile = $ENV{'HOME'} . '/.GnuDIP2' . $cfgsuff;
} else {
  # get path to our parent directory
  my $binpath = $FindBin::Bin;
  $configfile = $binpath . '/gdipc.conf' . $cfgsuff;
}
if ($configfile =~ /(.*)/) {
  $configfile = $1;
}

# setting preferences?
if ($opt_c) {
  setprefs();
  exit;
}

# variable for address returned by -q
my $queryaddress;

# hash of addresses already checked for validity
my %chkaddr;

# flag to indicate address(es) changed
my $addrchange;

# setting offline or not daemon mode?
if ($opt_r or ! defined $opt_d or ! $opt_d) {
  # do one run
  one_run();
  exit;
}

# daemon mode
close STDIN;
while (1) {

  # time now
  my $starttime = time();

  # do one run with a time out
  eval {
    local $SIG{ALRM} = sub { die "alarm\n" };
    alarm $opt_d;
    one_run();
    alarm 0;
  };

  # close log file?
  if ($opt_o) {
    close STDERR;
    close STDOUT;
  }

  # wait before repeating
  my $wait = $opt_d + $starttime - time();
  select(undef, undef, undef, $wait) if $wait > 0;

  # reopen log file?
  if ($opt_o) {
    open(STDOUT, ">$opt_o");
    open(STDERR, ">&STDOUT");
  }
}

#####################################################
# subroutines
#####################################################

# perform one run of the client action
sub one_run {

  # print heading
  my $now_string = localtime;
  print "====  $pgm running:  $now_string  ====\n";
  print "Configuration file name: $configfile\n";

  # any old query result expired
  undef $queryaddress;

  # open configuration file
  if (!open(CONFIG,"$configfile")) {
    print "You must first set up your preferences with \"$pgm -c\"\n";
    exit 1;
  }

  # what server action?
  my $serveraction;
  if ($opt_g and !$opt_q) {
    # update asking for IP address
    $serveraction = '2';
  } elsif ($opt_r) {
    # offline request
    $serveraction = '1';
  } else {
    # update passing IP address
    $serveraction = '0';
  }

  # no addresses validated yet
  %chkaddr = ();

  # no addresses have changed
  $addrchange = '';

  # check address and update address at servers
  while (my $line = <CONFIG>) {
    chomp($line);
    next if !$line;
    my ($username, $domain, $serverip, $password, $cachefile, $mintime, $maxtime)
      = split(/;/, $line);
    if (!$username or !$domain or !$serverip or !$password or
        !$cachefile or ! defined $mintime or $mintime eq '' or
        ! defined $maxtime or $maxtime eq '') {
      print "Ignoring bad line found in configuration file:\n==> $line\n";
      next;
    }
    sendlogin(
      $username, $password, $domain, $serverip, $serveraction,
      $cachefile, $mintime, $maxtime);
  }

  close(CONFIG);

  # need to run address change script?
  if ($opt_x and $addrchange) {
    my $cmd = $opt_x;
    foreach my $addr (keys %chkaddr) {
      $cmd .= " $addr" if $chkaddr{$addr};
    }
    # flush before command
    select(STDERR);
    $| = 1;
    select(STDOUT);
    $| = 1;
    #$cmd =~ s/\\/\\\\/g;
    #system(shellwords($cmd));
    system($cmd);
  }
}

# do interactive mode
sub interactive {

  print "Using Interactive Mode\n";

  print "Username: ";
  chomp(my $username = <STDIN>);

  print "Domain: ";
  chomp(my $domain = <STDIN>);

  print "Connect by direct TCP (d) or web server (w) [d]: ";
  chomp(my $srvtype = <STDIN>);
  $srvtype = 'd'
    if !($srvtype eq 'd' or $srvtype eq 'w');

  print "GnuDIP Server - host[:port]: ";
  chomp(my $serverip = <STDIN>);

  my $url;
  if ($srvtype eq 'w') {
    print "Server URL [/gnudip/cgi-bin/gdipupdt.cgi]: ";
    chomp(my $url = <STDIN>);
    $url = '/gnudip/cgi-bin/gdipupdt.cgi' if !$url;
    $serverip = "http://$serverip$url";
  }

  print "Password: ";
  chomp(my $password = <STDIN>);
  $password = md5_hex($password);

  # what server action?
  my $serveraction;
  if ($opt_g and !$opt_q) {
    # update asking for IP address
    $serveraction = '2';
  } elsif ($opt_r) {
    # offline request
    $serveraction = '1';
  } else {
    # update passing IP address
    $serveraction = '0';
  }

  # update address at server
  sendlogin($username, $password, $domain, $serverip, $serveraction);
}

# set preferences
sub setprefs {

  print "Using Update Configuration Mode\n";
  print "Configuration file name: $configfile\n";

  print "Username: ";
  chomp(my $username = <STDIN>);

  print "Domain: ";
  chomp(my $domain = <STDIN>);

  print "Connect by direct TCP (d) or web server (w) [d]: ";
  chomp(my $srvtype = <STDIN>);
  $srvtype = 'd'
    if !($srvtype eq 'd' or $srvtype eq 'w');

  print "GnuDIP Server - host[:port]: ";
  chomp(my $serverip = <STDIN>);

  my $url;
  if ($srvtype eq 'w') {
    print "Server URL [/gnudip/cgi-bin/gdipupdt.cgi]: ";
    chomp(my $url = <STDIN>);
    $url = '/gnudip/cgi-bin/gdipupdt.cgi' if !$url;
    $serverip = "http://$serverip$url";
  }

  print "Password: ";
  chomp(my $password = <STDIN>);
  $password = md5_hex($password);

  my $cachefile = '';
  if ($configfile =~ /^(.*)\/(.+?)$/) {
    my $cachedir  = $1;
    my $cachename = $2;
    if ($cachename =~ /^(.+?)\..*$/) {
      $cachename = $1;
    }
    $cachefile = "$cachedir/$cachename.cache.$username.$domain" . $cfgsuff;
  }
  print "Cache File [$cachefile]: ";
  chomp(my $newcache = <STDIN>);
  $cachefile = $newcache if $newcache ne '';
  # trust $cachefile
  if ($cachefile =~ /(.*)/) {
    $cachefile = $1;
  }

  my $mintime = '0';
  print "Minimum Seconds Between Updates [$mintime]: ";
  chomp(my $newmin = <STDIN>);
  $mintime = $newmin if $newmin ne '';

  my $maxtime = '2073600';
  print "Maximum Seconds Between Updates [$maxtime]: ";
  chomp(my $newmax = <STDIN>);
  $maxtime = $newmax if $newmax ne '';

  # update configuration file
  my @oldconfig = ();
  if (open(CONFIG, "$configfile")) {
    while (my $line = <CONFIG>) {
      chomp($line);
      next if !$line;
      push @oldconfig, ($line);
    }
    close(CONFIG);
  }
  open(CONFIG, ">$configfile") or
    die "Could not create configuration file $configfile: $!\n";
  foreach my $line (@oldconfig) {
    my ($oldusername, $olddomain) = split(/;/, $line);
    if ($oldusername ne $username || $olddomain ne $domain) {
      print CONFIG "$line\n";
    }
  }
  print CONFIG
    "$username;$domain;$serverip;$password;$cachefile;$mintime;$maxtime\n";