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; our $VERSION = '1.00'; 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; return $self; } 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. =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 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 key, which specifies the amount of indentation per nesting level. If B 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 is present, and its value is evaluated as true, then comments are reindented following the rules described above.