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