git.8kb.co.uk Git - slony-i/pgbouncer_follower/blob - pgbouncer_follower.pl

   1 #!/usr/bin/perl
   2
   3 # Script:   pgbouncer_follower.pl
   4 # Copyright:    22/04/2012: v1.0.1 Glyn Astill <glyn@8kb.co.uk>
   5 # Requires: Perl 5.10.1+, PostgreSQL 9.0+ Slony-I 2.0+
   6 #
   7 # This script is a command-line utility to monitor Slony-I clusters
   8 # and reconfigure pgbouncer to follow replication sets.
   9 #
  10 # This script is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation, either version 3 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This script is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this script.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 use strict;
  24 use warnings;
  25 use experimental 'smartmatch';
  26 use DBI;
  27 use v5.10.1;
  28 use Getopt::Long qw/GetOptions/;
  29 use Digest::MD5 qw/md5 md5_hex md5_base64/;
  30 use Sys::Hostname;
  31 use IO::Socket;
  32 use Time::HiRes qw/usleep/;
  33 use sigtrap 'handler' => \&cleanExit, 'HUP', 'INT','ABRT','QUIT','TERM';
  34 Getopt::Long::Configure qw/no_ignore_case/;
  35
  36 use vars qw{%opt};
  37
  38 use constant false => 0;
  39 use constant true  => 1;
  40
  41 my $g_usage = 'Pass configuration file: pool_follower.pl -f <configuration_path> [-D]  ';
  42 my $g_debug = false;
  43 my $g_pidfile = "/tmp/pgbouncer_follower_%mode.pid";
  44 my $g_logfile = "/tmp/pgbouncer_follower_%mode.log";
  45 my $g_poll_interval = 1000;
  46 my $g_user = "slony";
  47 my $g_pass;
  48 my $g_clname = "replication";
  49 my $g_clsets = "1";
  50 my @g_conninfos;
  51 my @g_cluster;                  # no_id, no_comment, no_prov, orig_sets, conninfo, dbname, host, port
  52 my $g_status_file = "/tmp/pgbouncer_follower_%mode.status";
  53 my $g_conf_template = "/etc/pgbouncer/pgbouncer_%mode.template";
  54 my $g_conf_target = "/etc/pgbouncer/pgbouncer_%mode.ini";
  55 my $g_reload_command = "/etc/init.d/pgbouncer_%mode reload";
  56 my $g_mode = 'rw';
  57 my $g_all_databases=false;
  58 my ($year, $month, $day, $hour, $min, $sec);
  59 my $change_time;
  60 my $g_host = hostname;
  61 my ($g_addr)=inet_ntoa((gethostbyname(hostname))[4]);
  62 my $g_origins_only = false;
  63 my $g_best_config = false;
  64 my $g_max_lag = 0;
  65
  66 die $g_usage unless GetOptions(\%opt, 'config_file|f=s', 'daemon|D',) and keys %opt and ! @ARGV;
  67
  68 unless (getConfig($opt{config_file})){
  69     print ("There was a problem reading the configuration.\n");
  70 }
  71
  72 if ($g_debug) {
  73     printLogLn($g_logfile, "DEBUG: Logging to my '$g_logfile'");
  74     printLogLn($g_logfile, "\t Watching sets $g_clsets in Slony-I cluster '$g_clname' polling every ${g_poll_interval}ms");
  75     printLogLn($g_logfile, "\t Following " . ($g_all_databases ? "all databases" : "replicated database only") . " on an '$g_mode' node for the above replicated sets");
  76     printLogLn($g_logfile, "\t Template config '$g_conf_template' Target config '$g_conf_target'");
  77     printLogLn($g_logfile, "\t Reload command is '$g_reload_command'");
  78     printLogLn($g_logfile, "\t Status stored in '$g_status_file'");
  79     printLogLn($g_logfile, "\t Using local address for '$g_host' as '$g_addr'");
  80     if (($g_max_lag > 0) && ($g_mode = 'ro')) {
  81         printLogLn($g_logfile, "\t Max lag for read only targets will be $g_max_lag seconds");
  82     }
  83     #printLogLn($g_logfile, "\t '$g_user' as '$g_pass'");
  84 }
  85
  86 if (defined($opt{daemon})) {
  87     printLogLn($g_logfile, "pgbouncer_follower starting up");
  88     if (writePID($g_pidfile)) {
  89         while (true) {
  90             doAll();
  91             if ($g_debug) {
  92                 printLogLn($g_logfile, "DEBUG: Sleeping for ${g_poll_interval}ms");
  93             }
  94             usleep($g_poll_interval * 1000);
  95         }
  96     }
  97 }
  98 else {
  99     doAll();
 100 }
 101
 102 cleanExit(0);
 103
 104 sub cleanExit {
 105     if (defined($opt{daemon})) {
 106         printLogLn($g_logfile, "pgbouncer_follower shutting down");
 107         removePID($g_pidfile);
 108     }
 109     exit(0);
 110 }
 111
 112 sub doAll {
 113     my $node_to;
 114     my $conninfo_read = 0;
 115
 116     foreach my $conninfo (@g_conninfos) {
 117         $conninfo_read++;
 118         eval {
 119             @g_cluster = loadCluster($g_clname, $conninfo, $g_user, $g_pass, $g_addr, $g_clsets);
 120             if ($g_debug) {
 121                 printLogLn($g_logfile, "DEBUG: ($conninfo_read) Cluster with " . scalar(@g_cluster) . " nodes read from conninfo: $conninfo");
 122                 foreach (@g_cluster) {
 123                     printLogLn($g_logfile, "DEBUG: Node #" . @$_[0] . " DETAIL: " . @$_[1] . " " . @$_[2] . " " . (@$_[3] // "<NONE>") . " " . @$_[4] . " " . (@$_[5] // "<NONE>") . " " . @$_[6] . " " . @$_[7] . " " . @$_[8] . " " . @$_[9] . " " . @$_[10] . " "  . @$_[11]);
 124                 }
 125             }
 126         };
 127         if ($@) {
 128             printLogLn($g_logfile, "ERROR: Failed using conninfo: $conninfo DETAIL: $@");
 129         }
 130         elsif($g_best_config) {
 131             if ($g_debug) {
 132                 printLogLn($g_logfile, "DEBUG: Found current origin to read config from");
 133             }
 134             last;
 135         }
 136     }
 137     unless (checkCluster($g_status_file)) {
 138         if ($g_debug) {
 139              printLogLn ($g_logfile, "DEBUG: Cluster status unchanged");
 140         }
 141     }
 142     else {
 143         printLogLn ($g_logfile, "Cluster status changed");
 144         $node_to = generateConfig($g_conf_template, $g_conf_target, $g_mode, $g_all_databases, $g_clsets);
 145         if (reloadConfig($g_reload_command)) {
 146             printLogLn ($g_logfile, "Pool repointed to node #$node_to");
 147         }
 148     }
 149 }
 150
 151 sub reloadConfig {
 152     my $reload_command = shift;
 153     my $success = true;
 154     if(length($reload_command // '')) {
 155         printLogLn($g_logfile, "Running '$reload_command'");
 156         eval {
 157             open(RELOAD, "-|", $reload_command . " 2>&1");
 158             while (<RELOAD>) {
 159                 printLogLn($g_logfile, $_);
 160             }
 161             close(RELOAD);
 162             printLogLn($g_logfile, "Reload command has been run.");
 163         };
 164         if ($@) {
 165             printLogLn($g_logfile, "ERROR: Failed to run reload command DETAIL: $@");
 166             $success = false;
 167         }
 168     }
 169     return $success;
 170 }
 171
 172 sub generateConfig {
 173     my $template = shift;
 174     my $target = shift;
 175     my $mode = shift;
 176     my $all_databases = shift;
 177     my $clsets = shift;
 178
 179     my $success = false;
 180     my @sets_to_follow;
 181     my @sets_origin;
 182     my @sets_subscribed;
 183     my $target_node_id;
 184     my $target_db;
 185     my $target_host;
 186     my $target_sets;
 187     my $target_port = 5432;
 188     my $target_is_origin;
 189
 190     if ($g_debug) {
 191         printLogLn($g_logfile, "DEBUG: All databases = " . ($g_all_databases ? 'true' : 'false'));
 192     }
 193
 194     if (open(INFILE, "<", $template)) {
 195         if (open(OUTFILE, ">", $target)) {
 196             print OUTFILE "# Configuration file autogenerated at " . getRuntime() . " from $template\n";
 197             foreach (<INFILE>) {
 198                if (m/\[databases]/) {
 199
 200                     # Try and choose a node; we always assign the origin initially regardless of rw/ro status
 201                     # when in ro mode and if we then  find a suitable subscriber we'll reassign to it.
 202                     foreach my $node (@g_cluster) {
 203
 204
 205                         # If the node is lagging anyway skip it
 206                         if (($g_mode eq 'ro') && ($g_max_lag > 0) && ($node->[11])) {
 207                             printLogLn ($g_logfile, "Lag on node $node->[0] exceeds $g_max_lag seconds");
 208                             next;
 209                         }
 210
 211                         if ($clsets ne 'all') {
 212                             @sets_to_follow = split(',', $clsets);
 213                             if (defined($node->[3])) {
 214                                 @sets_origin =  split(',', $node->[3]);
 215                             }
 216                             else {
 217                                 undef @sets_origin;
 218                             }
 219                             if (defined($node->[5])) {
 220                                 @sets_subscribed =  split(',', $node->[5]);
 221                             }
 222                             else {
 223                                 undef @sets_subscribed;
 224                             }
 225                         }
 226
 227                         if (($clsets eq 'all' && defined($node->[3])) || (@sets_to_follow && @sets_origin && checkProvidesAllSets(\@sets_to_follow, \@sets_origin))) {
 228                             if (defined($node->[8])) {
 229                                 $target_db = $node->[7];
 230                                 $target_host = $node->[8];
 231                                 $target_node_id = $node->[0];
 232                                 $target_sets = $node->[3];
 233                                 $target_is_origin = true;
 234                             }
 235                             if (defined($node->[9])) {
 236                                 $target_port = $node->[9];
 237                             }
 238                             if ($mode eq "rw") {
 239                                 last;
 240                             }
 241                         }
 242                         elsif (($mode eq "ro") && (($clsets eq 'all') || (@sets_to_follow && @sets_subscribed && checkProvidesAllSets(\@sets_to_follow, \@sets_subscribed)))) {
 243                             if (defined($node->[8])) {
 244                                 $target_db = $node->[7];
 245                                 $target_host = $node->[8];
 246                                 $target_node_id = $node->[0];
 247                                 $target_sets = ($node->[5] // $node->[3]);
 248                                 $target_is_origin = false;
 249                             }
 250                             if (defined($node->[9])) {
 251                                 $target_port = $node->[9];
 252                             }
 253                             last;
 254                         }
 255                     }
 256                     if (defined($target_host)) {
 257                         $_ = "# Configuration for " . ($target_is_origin ? "origin" : "subscriber") . " of sets $target_sets node #$target_node_id $target_host:$target_port\n" . $_;
 258                         if ($g_debug) {
 259                             printLogLn ($g_logfile, "DEBUG: Configuration for " . ($target_is_origin ? "origin" : "subscriber") . " of sets $target_sets node #$target_node_id $target_host:$target_port");
 260                         }
 261                         if ($all_databases) {
 262                             $_ =~ s/(\[databases\])/$1\n\* = host=$target_host port=$target_port/;
 263                         }
 264                         else {
 265                             $_ =~ s/(\[databases\])/$1\n$target_db = host=$target_host port=$target_port dbname=$target_db/;
 266                         }
 267                     }
 268                     else {
 269                             $_ = "# Could not find any node providing sets $g_clsets in mode $mode\n";
 270                             printLogLn ($g_logfile, "DEBUG: Could not find any node providing sets $g_clsets in mode $mode");
 271                     }
 272
 273                }
 274                print OUTFILE $_;
 275             }
 276             close (OUTFILE);
 277         }
 278         else {
 279             print ("ERROR: Can't open file $target\n");
 280         }
 281         close(INFILE);
 282     }
 283     else {
 284         print ("ERROR: Can't open file $template\n");
 285     }
 286     return $target_node_id;
 287 }
 288
 289 sub checkCluster {
 290     my $infile = shift;
 291     my $changed = false;
 292     my $current_state = md5_hex('INIT');
 293     my $previous_state;
 294     foreach (@g_cluster) {
 295         if (!$g_origins_only || defined($_->[3])) {
 296             $current_state = md5_hex(($current_state // "") . $_->[0] . $_->[2] . (defined($_->[3]) ? 't' : 'f') . $_->[6] . $_->[11]);
 297             if ($g_debug) {
 298                 printLogLn($g_logfile, "DEBUG: Node " . $_->[0] . " detail = " . $_->[2] . (defined($_->[3]) ? 't' : 'f') . $_->[6] . $_->[11]);
 299             }
 300         }
 301     }
 302
 303     if (-f $infile) {
 304         if (open(CLUSTERFILE, "<", $infile)) {
 305             $previous_state = <CLUSTERFILE>;
 306             close(CLUSTERFILE);
 307         }
 308         else {
 309             printLogLn ($g_logfile, "ERROR: Can't open file $infile for reading");
 310         }
 311     }
 312
 313     unless (-f $infile && ($current_state eq $previous_state)) {
 314         if ($g_debug) {
 315                 printLogLn($g_logfile, "DEBUG: Writing to status file");
 316         }
 317         if (open(CLUSTERFILE, ">", $infile)) {
 318             print CLUSTERFILE $current_state;
 319             close(CLUSTERFILE);
 320         }
 321         else {
 322             printLogLn ($g_logfile, "ERROR: Can't open file $infile for writing");
 323         }
 324     }
 325
 326     if ((($previous_state // "") ne "") && ($current_state ne $previous_state)){
 327         $changed = true;
 328     }
 329
 330     return $changed
 331 }
 332
 333 sub loadCluster {
 334     my $clname = shift;
 335     my $conninfo = shift;
 336     my $dbuser = shift;
 337     my $dbpass = shift;
 338     my $addr = shift;
 339     my $clsets = shift;
 340     my $param_on = 1;
 341
 342     my $dsn;
 343     my $dbh;
 344     my $sth;
 345     my $query;
 346     my $version;
 347     my $qw_clname;
 348     my @cluster;
 349
 350     $g_best_config = false;
 351     $dsn = "DBI:Pg:$conninfo};";
 352
 353     eval {
 354         $dbh = DBI->connect($dsn, $dbuser, $dbpass, {RaiseError => 1});
 355         $qw_clname = $dbh->quote_identifier("_" . $clname);
 356
 357         $query = "SELECT $qw_clname.getModuleVersion()";
 358         $sth = $dbh->prepare($query);
 359         $sth->execute();
 360         ($version) = $sth->fetchrow;
 361         $sth->finish;
 362
 363         $query = "WITH x AS (
 364                 SELECT a.no_id,
 365                     a.no_comment,
 366                     COALESCE(b.sub_provider, 0) AS no_prov,
 367                     NULLIF(array_to_string(array(SELECT set_id FROM $qw_clname.sl_set WHERE set_origin = a.no_id" .
 368                     ($clsets ne "all" ? " AND set_id IN (" . substr('?, ' x scalar(split(',', $clsets)), 0, -2) . ")" : "")
 369                     . " ORDER BY set_id), ','), '') AS origin_sets,
 370                     CASE " . ((substr($version,0,3) >= 2.2) ? "WHEN a.no_failed THEN 'FAILED' " : "") . "WHEN a.no_active THEN 'ACTIVE' ELSE 'INACTIVE' END AS no_status,
 371                     string_agg(CASE WHEN b.sub_receiver = a.no_id AND b.sub_forward AND b.sub_active" .
 372                     ($clsets ne "all" ? " AND b.sub_set IN (" . substr('?, ' x scalar(split(',', $clsets)), 0, -2) . ")" : "")
 373                     . " THEN b.sub_set::text END, ',' ORDER BY b.sub_set) AS prov_sets,
 374                     COALESCE(c.pa_conninfo,(SELECT pa_conninfo FROM $qw_clname.sl_path WHERE pa_server = $qw_clname.getlocalnodeid(?) LIMIT 1)) AS no_conninfo
 375                 FROM $qw_clname.sl_node a
 376                 LEFT JOIN $qw_clname.sl_subscribe b ON a.no_id = b.sub_receiver AND b.sub_set <> 999
 377                 LEFT JOIN $qw_clname.sl_path c ON c.pa_server = a.no_id AND c.pa_client = $qw_clname.getlocalnodeid(?)
 378                 LEFT JOIN $qw_clname.sl_set d ON d.set_origin = a.no_id
 379                 GROUP BY b.sub_provider, a.no_id, a.no_comment, c.pa_conninfo, a.no_active
 380                 ORDER BY (COALESCE(b.sub_provider, 0) = 0) DESC, a.no_id ASC
 381                 ), z AS (
 382                 SELECT x.*,
 383                     CASE WHEN x.no_conninfo ilike '%dbname=%' THEN(regexp_matches(x.no_conninfo, E'dbname=(.+?)\\\\M', 'ig'))[1] END AS database,
 384                     CASE WHEN x.no_conninfo ilike '%host=%' THEN(regexp_matches(x.no_conninfo, E'host=(.+?)(?=\\\\s|\$)', 'ig'))[1] END AS host,
 385                     CASE WHEN x.no_conninfo ilike '%port=%' THEN(regexp_matches(x.no_conninfo, E'port=(.+?)\\\\M', 'ig'))[1] ELSE '5432' END AS port,
 386                     (no_id = $qw_clname.getlocalnodeid(?)) AS this_node,
 387                     COALESCE((? BETWEEN 1 AND extract(epoch from s.st_lag_time)),false) AS lag_exceeded
 388                 FROM x
 389                 LEFT JOIN $qw_clname.sl_status s ON s.st_received = x.no_id
 390                 )
 391                 SELECT * FROM z
 392                 ORDER BY origin_sets, @(CASE WHEN (host ~ '^[0-9]{1,3}(.[0-9]{1,3}){3}\$') THEN host::inet ELSE '255.255.255.255'::inet END - ?::inet) ASC";
 393
 394         if ($g_debug) {
 395 #            printLogLn($g_logfile, "DEBUG: " . $query);
 396         }
 397
 398         $sth = $dbh->prepare($query);
 399
 400         if ($clsets ne "all") {
 401             for (0..1) {
 402                 foreach my $param (split(",", $clsets)) {
 403                     $sth->bind_param($param_on, $param);
 404                     $param_on++;
 405                 }
 406             }
 407         }
 408         # This param is taken 3 times
 409         for (0..2) {
 410             $sth->bind_param($param_on, "_" . $clname);
 411             $param_on++;
 412         }
 413         $sth->bind_param($param_on, $g_max_lag);
 414         $param_on++;
 415         $sth->bind_param($param_on, (isInet($addr) ? $addr : '255.255.255.255'));
 416         $sth->execute();
 417
 418         while (my @node = $sth->fetchrow) {
 419             # If some origin sets exist for this node row (we can assume they're the sets we're following since they're filtered in the query)
 420             # and the row is flagged as this_node then we have found the best node to read the configuration from.
 421             if (defined($node[3]) && $node[10]) {
 422                 $g_best_config = true;
 423             }
 424             push(@cluster,  \@node);
 425         }
 426
 427         $sth->finish;
 428         $dbh->disconnect();
 429     };
 430     if ($@) {
 431         printLogLn($g_logfile, "ERROR: Failed to execute query against Postgres server: $@");
 432     }
 433
 434     return @cluster;
 435 }
 436
 437 sub getConfig {
 438     my @fields;
 439     my $success = false;
 440     my $infile = shift;
 441     my $value;
 442
 443     if (open(CFGFILE, "<", $infile)) {
 444         foreach (<CFGFILE>) {
 445             chomp $_;
 446             for ($_) {
 447                 s/\r//;
 448                 #s/\#.*//;
 449                 s/#(?=(?:(?:[^']|[^"]*+'){2})*+[^']|[^"]*+\z).*//;
 450             }
 451             if (length(trim($_))) {
 452                 @fields = split('=', $_, 2);
 453                 $value = qtrim(trim($fields[1]));
 454                 given(lc($fields[0])) {
 455                     when(/\bdebug\b/i) {
 456                         $g_debug = checkBoolean($value);
 457                     }
 458                     when(/\bpid_file\b/i) {
 459                         $g_pidfile = $value;
 460                     }
 461                     when(/\blog_file\b/i) {
 462                         $g_logfile = $value;
 463                     }
 464                     when(/\bslony_user\b/i) {
 465                         $g_user = $value;
 466                     }
 467                     when(/\bslony_pass\b/i) {
 468                         $g_pass = $value;
 469                     }
 470                     when(/\bslony_cluster_name\b/i) {
 471                         $g_clname = $value;
 472                     }
 473                     when(/\bslony_sets_to_follow\b/i) {
 474                         $g_clsets = $value;
 475                     }
 476                     when(/\bserver_conninfo\b/i) {
 477                         push(@g_conninfos, $value);
 478                     }
 479                     when(/\bfollower_poll_interval\b/i) {
 480                         $g_poll_interval = checkInteger($value);
 481                     }
 482                     when(/\bstatus_file\b/i) {
 483                         $g_status_file = $value;
 484                     }
 485                     when(/\bpool_conf_template\b/i) {
 486                         $g_conf_template = $value;
 487                     }
 488                     when(/\bpool_conf_target\b/i) {
 489                         $g_conf_target = $value;
 490                     }
 491                     when(/\bpool_reload_command\b/i) {
 492                         $g_reload_command = $value;
 493                     }
 494                     when(/\bpool_mode\b/i) {
 495                         $g_mode = lc($value);
 496                     }
 497                     when(/\bpool_all_databases\b/i) {
 498                         $g_all_databases = checkBoolean($value);
 499                     }
 500                     when(/\bonly_follow_origins\b/i) {
 501                         $g_origins_only = checkBoolean($value);
 502                     }
 503                     when(/\bmax_ro_lag\b/i) {
 504                         $g_max_lag = checkInteger($value);
 505                     }
 506                 }
 507             }
 508         }
 509         close (CFGFILE);
 510         if (defined($g_user) && (scalar(@g_conninfos) > 0)) {
 511            $success = true;
 512         }
 513         # Replace %mode and %clname here for actual value
 514         for ($g_pidfile, $g_logfile, $g_status_file, $g_conf_template, $g_conf_target, $g_reload_command) {
 515             s/\%mode/$g_mode/g;
 516             s/\%clname/$g_clname/g;
 517         }
 518
 519
 520     }
 521     else {
 522         printLogLn($g_logfile, "ERROR: Could not read configuration from '$infile'");
 523     }
 524     return $success;
 525 }
 526
 527 sub writePID {
 528     my $pidfile = shift;
 529     my $success = true;
 530
 531     eval {
 532         open (PIDFILE, ">", $pidfile);
 533         print PIDFILE $$;
 534         close (PIDFILE);
 535         if ($g_debug) {
 536             printLogLn($g_logfile, "DEBUG: Created PID file '$pidfile' for process $$");
 537         }
 538     };
 539     if ($@) {
 540         printLogLn($g_logfile, "ERROR: unable to write pidfile at '$pidfile' DETAIL $!");
 541         $success = false;
 542     }
 543     return $success;
 544 }
 545
 546 sub removePID {
 547     my $pidfile = shift;
 548     my $success = true;
 549
 550     eval {
 551         if (-f $pidfile) {
 552             unlink $pidfile;
 553             if ($g_debug) {
 554                 printLogLn($g_logfile, "DEBUG: Removed PID file '$pidfile'");
 555             }
 556         }
 557         elsif ($g_debug){
 558             printLogLn($g_logfile, "DEBUG: PID file '$pidfile' never existed to be removed");
 559         }
 560     };
 561     if ($@) {
 562         printLogLn($g_logfile, "ERROR: unable to remove pidfile at '$pidfile' DETAIL $!");
 563         $success = false;
 564     }
 565     return $success
 566 }
 567
 568 sub checkBoolean {
 569     my $text = shift;
 570     my $value = undef;
 571     if ( grep /^$text$/i, ("y","yes","t","true","on") ) {
 572         $value = true;
 573     }
 574     elsif ( grep /^$text$/i, ("n","no","f","false","off") ) {
 575         $value = false;
 576     }
 577     return $value;
 578 }
 579
 580 sub checkInteger {
 581     my $integer = shift;
 582     my $value = undef;
 583
 584     if (($integer * 1) eq $integer) {
 585         $value = int($integer);
 586     }
 587     return $value;
 588 }
 589
 590 sub checkProvidesAllSets {
 591     my ($originSets, $providerSets) = @_;
 592     my %test_hash;
 593
 594     undef @test_hash{@$originSets};       # add a hash key for each element of @$originSets
 595     delete @test_hash{@$providerSets};    # remove all keys for elements of @$providerSets
 596
 597     return !%test_hash;              # return false if any keys are left in the hash
 598 }
 599
 600 sub isInet {
 601     my $address = shift;
 602     my $success = true;
 603
 604     my(@octets) = $address =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
 605     if (@octets == 4) {
 606         foreach (@octets) {
 607             unless ($_ <= 255) {
 608                 $success = false;
 609             }
 610         }
 611     }
 612     else {
 613         $success = false;
 614     }
 615
 616     return $success;
 617 }
 618
 619 sub qtrim {
 620     my $string = shift;
 621     $string =~ s/^('|")+//;
 622     $string =~ s/('|")+$//;
 623     return $string;
 624 }
 625
 626 sub trim {
 627     my $string = shift;
 628     $string =~ s/^\s+//;
 629     $string =~ s/\s+$//;
 630     return $string;
 631 }
 632
 633 sub getRuntime {
 634     my ($year, $month, $day, $hour, $min, $sec) = (localtime(time))[5,4,3,2,1,0];
 635     my $time = sprintf ("%02d:%02d:%02d on %02d/%02d/%04d", $hour, $min, $sec, $day, $month+1, $year+1900);
 636     return $time;
 637 }
 638
 639 sub printLog {
 640     my $logfile = shift;
 641     my $message = shift;
 642
 643     print $message;
 644
 645     if (open(LOGFILE, ">>", $logfile)) {
 646         print LOGFILE getRuntime() . " " . $message;
 647         close (LOGFILE);
 648     }
 649     else {
 650         printLn("ERROR: Unable to write to logfile $logfile");
 651     }
 652 }
 653
 654 sub printLogLn {
 655     printLog ($_[0], $_[1] . $/);
 656 }
 657
 658 sub printLn {
 659     print ((@_ ? join($/, @_) : $_), $/);
 660 }