Check configuration file syntax before saving it

* Makefile.PL: Require IPC::Cmd
* lib/Config/HAProxy.pm (lint): New method.
(save): Call linter prior to saving. Take optional dry_run keyword
as argument.
* t/lint.t: New file.

4 files changed, 153 insertions, 10 deletions

diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index c1d2412..e7c7b44 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -60,4 +60,4 @@
 ^\.emacs\.*
 \.tar$
 \.tar\.gz$
-Config/HAProxy/VirtualHost.pm
+
diff --git a/Makefile.PL b/Makefile.PL
index d9cc6e8..754d3aa 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -16,7 +16,8 @@ WriteMakefile(
         'Text::Locus'      => 1.00,
         'Text::ParseWords' => 0,
         'File::Basename'   => 0,
-        'File::Temp'       => 0
+        'File::Temp'       => 0,
+        'IPC::Cmd'         => 0
     },
     META_MERGE        => {
         'meta-spec' => { version => 2 },
diff --git a/lib/Config/HAProxy.pm b/lib/Config/HAProxy.pm
index 9a8d666..ff4fa8a 100644
--- a/lib/Config/HAProxy.pm
+++ b/lib/Config/HAProxy.pm
@@ -12,6 +12,8 @@ use Text::ParseWords;
 use File::Basename;
 use File::Temp qw(tempfile);
 use File::stat;
+use File::Spec;
+use IPC::Cmd;
 use Carp;
 
 our $VERSION = '1.01';
@@ -26,7 +28,8 @@ my %sections = (
 sub new {
     my $class = shift;
     my $filename = shift // '/etc/haproxy/haproxy.cfg';
-    my $self = bless { _filename => $filename }, $class;
+    my $self = bless { _filename => $filename,
+                       _lint => { enable => 1 } }, $class;
     $self->reset();
     return $self;
 }
@@ -169,15 +172,74 @@ sub write {
     close $fh unless ref($file) eq 'GLOB';
 }
 
-sub save {
+sub lint {
     my $self = shift;
 
+    if (@_) {
+        if (@_ == 1) {
+            $self->{_lint}{enable} = !!shift;
+        } elsif (@_ % 2 == 0) {
+            local %_ = @_;
+            my $v;
+            if (defined($v = delete $_{enable})) {
+                $self->{_lint}{enable} = $v;
+            }
+            if (defined($v = delete $_{command})) {
+                $self->{_lint}{command} = $v;
+            }
+            if (defined($v = delete $_{path})) {
+                $self->{_lint}{path} = $v;
+            }
+            croak "unrecognized keywords" if keys %_;
+        } else {
+            croak "bad number of arguments";
+        }
+    }
+
+    if ($self->{_lint}{enable}) {
+        $self->{_lint}{command} ||= 'haproxy -c -f';
+        if ($self->{_lint}{path}) {
+            my ($prog, $args) = split /\s+/, $self->{_lint}{command}, 2;
+            if (!File::Spec->file_name_is_absolute($prog)) {
+                foreach my $dir (split /:/, $self->{_lint}{path}) {
+                    my $name = File::Spec->catfile($dir, $prog);
+                    if (-x $name) {
+                        $prog = $name;
+                        last;
+                    }
+                }
+                if ($args) {
+                    $prog .= ' '.$args;
+                }
+                $self->{_lint}{command} = $prog;
+            }
+        }
+        return $self->{_lint}{command};
+    }
+}
+
+sub save {
+    my $self = shift;
+    croak "bad number of arguments" if @_ % 2;
+    local %_ = @_;
+    my $dry_run = delete $_{dry_run};
+    my @wrargs = %_;
+    
     return unless $self->tree;# FIXME
     return unless $self->tree->is_dirty;
     my ($fh, $tempfile) = tempfile('haproxy.XXXXXX',
                                    DIR => dirname($self->filename));
-    $self->write($fh, @_);
+    $self->write($fh, @wrargs);
     close($fh);
+
+    if (my $cmd = $self->lint) {
+        my ($ok, $err, undef, undef, $errbuf) =
+            IPC::Cmd->run(command => "$cmd $tempfile");
+        unless ($ok) {
+            croak "Syntax check failed: $errbuf\n";
+        }
+    }
+    return 1 if $dry_run;
     
     my $sb = stat($self->filename);
     $self->backup;
@@ -188,7 +250,8 @@ sub save {
     # This will fail unless we are root, let it be so.
     chown $sb->uid, $sb->gid, $self->filename;
     
-    $self->tree->clear_dirty
+    $self->tree->clear_dirty;
+    return 1;
 }
 
 sub backup_name {
@@ -233,9 +296,12 @@ Config::HAProxy - Parser for HAProxy configuration file
         # do something with $node
     }
 
-    $cfg->save;
+    $cfg->lint(enable => 1, command => 'haproxy -c -f',
+               path => '/sbin:/usr/sbin')
+
+    $cfg->save(%hash);
 
-    $cfg->write($file_or_handle);
+    $cfg->write($file_or_handle, %hash);
 
     $cfg->backup;
     $name = $self->backup_name;
@@ -361,11 +427,54 @@ Returns the last node in the tree.
     
 =head1 SAVING
 
+=head2 lint
+
+    $cfg->lint(%ARGS);
+
+Configures syntax checking program to be run before saving. Takes a
+hash as argument. Allowed keys are:
+
+=over 4
+
+=item B<enable =E<gt> I<BOOL>>
+
+If I<BOOL> is 0, disables syntax check.  Default is 1.
+
+=item B<command =E<gt> I<CMD>>    
+
+Configures the command to use for syntax check. The command will be run as
+
+    CMD FILE
+
+where I<FILE> is the name of the HAProxy configuration file to check.
+
+Default command is B<haproxy -c -f>.
+
+=item B<path =E<gt> I<PATH>>
+
+Sets the search path for the check program. I<PATH> is a colon-delimited
+list of directories. Unless the first word of B<command> is an absolute
+file name, it will be looked for in these directories. The first match
+will be used. Default is system B<$PATH>.    
+
+=back
+
+Returns the command name.
+
 =head2 save
 
-    $cfg->save;
+    $cfg->save(%hash);
+
+Saves the parse tree in the configuration file. Syntax check will be run
+prior to saving (unless previously disabled). If syntax errors are discovered,
+the method will B<croak> with the appropriate diagnostics, beginning with
+words C<Syntax check failed:>.
+
+If I<%hash> contains a non-zero B<dry_run> value, B<save> will only run syntax
+check, without actually saving the file. If B<$cfg-E<gt>lint(enable =E<gt> 0)>
+was called previously, this is a no-op.
 
-Saves the parse tree in the configuration file.
+Other keys in I<%hash> are the same as in B<write>, described below.
 
 =head2 write
 
diff --git a/t/lint.t b/t/lint.t
new file mode 100644
index 0000000..aa92fd1
--- a/dev/null
+++ b/t/lint.t
@@ -0,0 +1,33 @@
+# -*- perl -*-
+use lib qw(t lib);
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+    plan tests => 7; 
+    use_ok('Test::HAProxy');
+}
+
+my $hp = new Test::HAProxy;
+isa_ok($hp,'Test::HAProxy');
+
+ok($hp->lint, 'haproxy -c -f');
+
+$hp->lint(0);
+ok(!$hp->lint);
+
+$hp->lint(1);
+ok($hp->lint, 'haproxy -c -f');
+
+$hp->lint(enable => 0);
+ok(!$hp->lint);
+
+$hp->lint(enable => 1, command => '/usr/local/bin/haproxy -c -f');
+ok($hp->lint, '/usr/local/bin/haproxy -c -f');
+
+__DATA__
+global
+    log /dev/log daemon
+    user haproxy
+    group haproxy