diff options
Diffstat (limited to 'lib/Config/HAProxy.pm')
-rw-r--r-- | lib/Config/HAProxy.pm | 326 |
1 files changed, 326 insertions, 0 deletions
diff --git a/lib/Config/HAProxy.pm b/lib/Config/HAProxy.pm new file mode 100644 index 0000000..45b0f1f --- /dev/null +++ b/lib/Config/HAProxy.pm @@ -0,0 +1,326 @@ +package Config::HAProxy; +use strict; +use warnings; +use Text::Locus; +use Config::HAProxy::Node::Root; +use Config::HAProxy::Node::Section; +use Config::HAProxy::Node::Statement; +use Config::HAProxy::Node::Comment; +use Config::HAProxy::Node::Empty; +use Text::ParseWords; +use File::Basename; +use File::Temp qw(tempfile); +use File::stat; +use Carp; + +my %sections = ( + global => 1, + defaults => 1, + frontend => 1, + backend => 1, +); + +sub new { + my $class = shift; + my $filename = shift // '/etc/haproxy/haproxy.cfg'; + my $self = bless { _filename => $filename }, $class; + $self->reset(); + return $self; +} + +sub filename { shift->{_filename} } + +sub parse { + my $self = shift; + + open(my $fh, '<', $self->filename) + or croak "can't open ".$self->filename.": $!"; + my $line = 0; + $self->reset(); + $self->push($self->tos); + while (<$fh>) { + my $locus = new Text::Locus($self->filename, ++$line); + chomp; + my $orig = $_; + s/^\s+//; + s/\s+$//; + + if ($_ eq "") { + $self->tos->append_node( + new Config::HAProxy::Node::Empty(locus => $locus)); + next; + } + + if (/^#.*/) { + $self->tos->append_node( + new Config::HAProxy::Node::Comment(orig => $orig, + locus => $locus)); + next; + } + + my @words = parse_line('\s+', 1, $_); + my $kw = shift @words; + if ($sections{$kw}) { + my $section = + new Config::HAProxy::Node::Section(kw => $kw, + argv => \@words, + orig => $orig, + locus => $locus); + $self->pop; + $self->tos->append_node($section); + $self->push($section); + } else { + $self->tos->append_node( + new Config::HAProxy::Node::Statement(kw => $kw, + argv => \@words, + orig => $orig, + locus => $locus)); + } + } + $self->pop; + close $fh; +} + +sub reset { + my $self = shift; + $self->{_stack} = [ new Config::HAProxy::Node::Root() ]; +} + +sub push { + my $self = shift; + push @{$self->{_stack}}, @_; +} + +sub pop { + my $self = shift; + croak "can't pop the root tree" if @{$self->{_stack}} == 1; + pop @{$self->{_stack}}; +} + +sub tos { + my $self = shift; + $self->{_stack}[-1]; +} + +sub tree { + my $self = shift; + $self->{_stack}[0]; +} + +sub select { + my $self = shift; + $self->tree->select(@_); +} + +sub iterator { + my $self = shift; + $self->tree->iterator(@_); +} + +sub write { + my $self = shift; + my $file = shift; + my $fh; + + if (ref($file) eq 'GLOB') { + $fh = $file; + } else { + open($fh, '>', $file) or croak "can't open $file: $!"; + } + + local %_ = @_; + my $itr = $self->iterator(inorder => 1); + + while (defined(my $node = $itr->next)) { + my $s = $node->as_string; + if ($_{indent}) { + if ($node->is_comment) { + if ($_{reindent_comments}) { + my $indent = ' ' x ($_{indent} * $node->depth); + $s =~ s/^\s+//; + $s = $indent . $s; + } + } else { + my $indent = ' ' x ($_{indent} * $node->depth); + if ($_{tabstop}) { + $s = $indent . $node->kw; + for (my $i = 0; my $arg = $node->arg($i); $i++) { + my $off = 1; + if ($i < @{$_{tabstop}}) { + if (($off = $_{tabstop}[$i] - length($s)) <= 0) { + $off = 1; + } + } + $s .= (' ' x $off) . $arg; + } + } else { + $s =~ s/^\s+//; + $s = $indent . $s; + } + } + } + print $fh $s,"\n"; + } + + close $fh unless ref($file) eq 'GLOB'; +} + +sub save { + my $self = shift; + + return unless $self->tree;# FIXME + return unless $self->tree->is_dirty; + my ($fh, $tempfile) = tempfile('haproxy.XXXXXX', + DIR => dirname($self->filename)); + $self->write($fh, @_); + close($fh); + + my $sb = stat($self->filename); + $self->backup; + rename($tempfile, $self->filename) + or croak "can't rename $tempfile to ".$self->tempfile.": $!"; + # This will fail unless we are root, let it be so. + chown $sb->uid, $sb->gid, $self->filename; + # This will succeed: we've created the file, so we're owning it. + chmod $sb->mode & 0777, $self->filename; + + $self->tree->clear_dirty +} + +sub backup_name { + my $self = shift; + $self->filename . '~' +} + +sub backup { + my $self = shift; + my $backup = $self->backup_name; + if (-f $backup) { + unlink $backup + or croak "can't unlink $backup: $!" + } + rename $self->filename, $self->backup_name + or croak "can't rename :" + . $self->filename + . " to " + . $self->backup_name + . ": $!"; +} + +1; +__END__ + +=head1 NAME + +Config::HAProxy - HAProxy configuration file + +=head1 SYNOPSIS + +use Config::HAProxy; +$cfg = new Config::HAProxy($filename); +$cfg->parse; + +$name = $cfg->filename; + +@frontends = $cfg->select(name => 'frontend'); + +$itr = $cfg->iterator(inorder => 1); +while (defined($node = $itr->next)) { + # do something with $node +} + +$cfg->save; + +$cfg->write($file_or_handle); + +$cfg->backup; +$name = $self->backup_name; + +$cfg->reset; +$cfg->push($node); +$node = $cfg->pop; +$node = $cfg->tos; +$node = $cfg->tree; + +=head1 DESCRIPTION + +FIXME + +=head1 CONSTRUCTOR + + $cfg = new Config::HAProxy($filename); + +Creates and returns a new object for manipulating the HAProxy configuration. +Optional B<$filename> specifies the name of the file to read configuration +from. It defaults to F</etc/haproxy/haproxy.cfg>. + +=head1 THE PARSE TREE + +=head2 parse + + $cfg->parse; + +Reads and parses the configuration file. Croaks if the file does not exist. + + +=head2 reset + + $cfg->reset; + +Clears the parse tree. + +=head2 push + + $cfg->push($node); + +Appends the B<$node> (the B<Config::HAProxy::Node> object), to the +end of the parse tree. + +=head2 pop + + $node = $cfg->pop; + +Removes the tail node from the tree and returns it. + +=head1 INSPECTING THE TREE + +=head2 tree + + $node = $cfg->tree; + +Returns the top of the tree. + +=head2 tos + + $node = $cfg->tos; + +Returns the last node in the tree. + +=head1 SAVING + +=head2 save + + $cfg->save; + +Saves the configuration file. + +=head2 write + + $cfg->write($file, %hash); + +Writes configuration to the named file or file handle. If B<$file> is the +only argument, the original indentation is preserved. Otherwise, if +B<%hash> controls the indentation of the output. It must contain at least +the B<indent> key, which specifies the amount of indentation per nesting +level. If B<tabstop> key is also present, its value must be a reference to +the list of tabstop columns. For each statement with arguments, this array +is consulted to determine the column number for each subsequent argument. +Arguments are zero-indexed. Starting column where the argument should be +placed is determined as B<$tabstop[$i]>, where B<$i> is the argument index. +Arguments with B<$i> greater than or equal to B<@tabstop> are appended to +the resulting output, preserving their original offsets. + +Normally, comments retain their original indentation. However, if the +key B<reintent_comments> is present, and its value is evaluated as true, +then comments are reindented following the rules described above. + |