summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2018-07-08 16:45:32 +0300
committerSergey Poznyakoff <gray@gnu.org>2018-07-08 16:45:32 +0300
commit10897f8a984a6dbc511403ca942fb8c7a8883349 (patch)
tree7740f48950d82cf2561c730384d61180649151b9
downloadconfig-haproxy-10897f8a984a6dbc511403ca942fb8c7a8883349.tar.gz
config-haproxy-10897f8a984a6dbc511403ca942fb8c7a8883349.tar.bz2
Initial commit
Spawned from the proxyctl project.
-rw-r--r--.gitignore16
-rw-r--r--MANIFEST.SKIP62
-rw-r--r--Makefile.PL34
-rw-r--r--lib/Config/HAProxy.pm326
-rw-r--r--lib/Config/HAProxy/Iterator.pm69
-rw-r--r--lib/Config/HAProxy/Node.pm99
-rw-r--r--lib/Config/HAProxy/Node/Comment.pm6
-rw-r--r--lib/Config/HAProxy/Node/Empty.pm6
-rw-r--r--lib/Config/HAProxy/Node/Root.pm31
-rw-r--r--lib/Config/HAProxy/Node/Section.pm143
-rw-r--r--lib/Config/HAProxy/Node/Statement.pm6
-rw-r--r--lib/Config/HAProxy/VirtualHost.pm224
12 files changed, 1022 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..405074e
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,16 @@
+*~
+\#*#
+.#*
+*.bak
+*.tar*
+.emacs.*
+/tmp/
+/debug.sh
+core
+/MANIFEST
+/MYMETA.*
+/Makefile
+/blib
+/pm_to_blib
+/META.json
+/META.yml
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..3429457
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,62 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+\B\.cvsignore$
+
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+\bMANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+\bBuild.bat$
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.tmp$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+
+# Avoid Devel::Cover and Devel::CoverX::Covered files.
+\bcover_db\b
+\bcovered\b
+
+# Avoid MYMETA files
+^MYMETA\.
+
+^debug.sh
+^tmp
+^\.emacs\.*
+\.tar$
+\.tar\.gz$
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..81e815b
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+use Module::Metadata;
+
+WriteMakefile(
+ NAME => 'Config::HAProxy',
+ VERSION_FROM => 'lib/Config/HAProxy.pm',
+ ABSTRACT_FROM => 'lib/Config/HAProxy.pm',
+ LICENSE => 'gpl_3',
+ AUTHOR => 'Sergey Poznyakoff <gray@gnu.org>',
+ MIN_PERL_VERSION => 5.006,
+ PREREQ_PM => {
+ 'Carp' => 0,
+ 'Clone' => 0,
+ 'Text::Locus' => 1.00,
+ 'Text::ParseWords' => 0,
+ 'File::Basename' => 0,
+ 'File::Temp' => 0
+ },
+ META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'git://git.gnu.org.ua/config-haproxy.git',
+ web => 'http://git.gnu.org.ua/cgit/config-haproxy.git/',
+ },
+ },
+ provides => Module::Metadata->provides(version => '1.4',
+ dir => 'lib')
+ }
+);
+
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.
+
diff --git a/lib/Config/HAProxy/Iterator.pm b/lib/Config/HAProxy/Iterator.pm
new file mode 100644
index 0000000..6b0208e
--- /dev/null
+++ b/lib/Config/HAProxy/Iterator.pm
@@ -0,0 +1,69 @@
+package Config::HAProxy::Iterator;
+use strict;
+use warnings;
+use Config::HAProxy::Node;
+use Carp;
+
+use constant {
+ NO_RECURSION => 0,
+ INORDER => 1,
+ POSTORDER => 2
+};
+
+sub new {
+ my $class = shift;
+ my $node = shift;
+ my $self = bless { }, $class;
+ if ($node->is_section) {
+ $self->{_list} = [ $node->tree() ];
+ } else {
+ $self->{_list} = [ $node ];
+ }
+ local %_ = @_;
+ if (defined($_{recursive})) {
+ $self->{_recursive} = $_{recursive};
+ } elsif ($_{inorder}) {
+ $self->{_recursive} = INORDER;
+ } elsif ($_{postorder}) {
+ $self->{_recursive} = POSTORDER;
+ } else {
+ $self->{_recursive} = NO_RECURSION;
+ }
+ return $self;
+}
+
+sub recursive { shift->{_recursive} }
+sub inorder { shift->{_recursive} == INORDER }
+sub postorder { shift->{_recursive} == POSTORDER }
+
+sub next {
+ my $self = shift;
+
+ if ($self->{_itr}) {
+ if (defined(my $v = $self->{_itr}->next())) {
+ return $v;
+ } else {
+ delete $self->{_itr};
+ return $self->{_cur} if $self->postorder;
+ }
+ }
+
+ if (defined($self->{_cur} = shift @{$self->{_list}})) {
+ if ($self->recursive && $self->{_cur}->is_section) {
+ $self->{_itr} = $self->{_cur}->iterator(recursive => $self->recursive);
+ if ($self->inorder) {
+ return $self->{_cur};
+ } else {
+ return $self->next();
+ }
+ }
+ }
+
+ return $self->{_cur};
+}
+
+1;
+
+
+
+
diff --git a/lib/Config/HAProxy/Node.pm b/lib/Config/HAProxy/Node.pm
new file mode 100644
index 0000000..be09538
--- /dev/null
+++ b/lib/Config/HAProxy/Node.pm
@@ -0,0 +1,99 @@
+package Config::HAProxy::Node;
+use strict;
+use warnings;
+use Carp;
+use Config::HAProxy::Iterator;
+
+sub new {
+ my $class = shift;
+ local %_ = @_;
+ bless {
+ _kw => $_{kw},
+ _argv => $_{argv} // [],
+ _orig => $_{orig},
+ _locus => $_{locus},
+ _parent => $_{parent},
+ _index => -1
+ }, $class;
+}
+
+my @ATTRIBUTES = qw(kw orig locus parent index);
+
+{
+ no strict 'refs';
+ foreach my $attribute (@ATTRIBUTES) {
+ *{ __PACKAGE__ . '::' . $attribute } = sub {
+ my $self = shift;
+ if (defined(my $val = shift)) {
+ croak "too many arguments" if @_;
+ $self->{'_'.$attribute} = $val;
+ }
+ return $self->{'_'.$attribute};
+ }
+ }
+}
+
+sub argv {
+ my $self = shift;
+ if (my $val = shift) {
+ croak "too many arguments" if @_;
+ $self->{_argv} = $val;
+ }
+ return @{$self->{_argv}};
+}
+
+sub arg {
+ my $self = shift;
+ my $n = shift;
+ if (my $val = shift) {
+ croak "too many arguments" if @_;
+ $self->{_argv}[$n] = $val;
+ }
+ return $self->{_argv}[$n];
+}
+
+sub drop {
+ my $self = shift;
+ $self->parent->delete_node($self->index);
+}
+
+sub iterator {
+ return new Config::HAProxy::Iterator(@_);
+}
+
+sub depth {
+ my $self = shift;
+ my $n = 0;
+ while ($self = $self->parent) {
+ $n++;
+ }
+ return $n - 1;
+}
+
+sub root {
+ my $self = shift;
+ while ($self->parent()) {
+ $self = $self->parent();
+ }
+ return $self;
+}
+
+sub as_string {
+ my $self = shift;
+ if (defined(my $v = $self->orig)) {
+ return $v;
+ }
+ return '' unless $self->kw;
+ return $self->orig(join(' ', ($self->kw, $self->argv())));
+}
+
+# use overload
+# '""' => sub { shift->as_string };
+
+sub is_root { 0 }
+sub is_section { 0 }
+sub is_statement { 0 }
+sub is_empty { 0 }
+sub is_comment { 0 }
+
+1;
diff --git a/lib/Config/HAProxy/Node/Comment.pm b/lib/Config/HAProxy/Node/Comment.pm
new file mode 100644
index 0000000..5d7ef88
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Comment.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Comment;
+use parent 'Config::HAProxy::Node';
+
+sub is_comment { 1 }
+
+1;
diff --git a/lib/Config/HAProxy/Node/Empty.pm b/lib/Config/HAProxy/Node/Empty.pm
new file mode 100644
index 0000000..bee0f2e
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Empty.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Empty;
+use parent 'Config::HAProxy::Node';
+
+sub is_empty { 1 }
+
+1;
diff --git a/lib/Config/HAProxy/Node/Root.pm b/lib/Config/HAProxy/Node/Root.pm
new file mode 100644
index 0000000..656bb9f
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Root.pm
@@ -0,0 +1,31 @@
+package Config::HAProxy::Node::Root;
+use strict;
+use warnings;
+use parent 'Config::HAProxy::Node::Section';
+use Carp;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{dirty} = 0;
+ return $self;
+}
+
+sub is_dirty {
+ my $self = shift;
+ return $self->{dirty}
+}
+
+sub mark_dirty {
+ my $self = shift;
+ $self->{dirty} = 1;
+}
+
+sub clear_dirty {
+ my $self = shift;
+ $self->{dirty} = 0;
+}
+
+1;
+
+
diff --git a/lib/Config/HAProxy/Node/Section.pm b/lib/Config/HAProxy/Node/Section.pm
new file mode 100644
index 0000000..c332155
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Section.pm
@@ -0,0 +1,143 @@
+package Config::HAProxy::Node::Section;
+use strict;
+use warnings;
+use parent 'Config::HAProxy::Node';
+use Carp;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{_tree} = [];
+ return $self;
+}
+
+sub is_section { 1 }
+
+sub append_node {
+ my $self = shift;
+ my $n = @{$self->{_tree}};
+ push @{$self->{_tree}},
+ map {
+ $_->parent($self);
+ $_->index($n++);
+ $_
+ } @_;
+}
+
+sub append_node_nonempty {
+ my $self = shift;
+ my $n = $#{$self->{_tree}};
+ while ($n >= 0 && $self->{_tree}[$n]->is_empty) {
+ $n--;
+ }
+ $self->insert_node($n+1, @_);
+}
+
+sub insert_node {
+ my $self = shift;
+ my $n = shift;
+ my $i = $n;
+ splice @{$self->{_tree}}, $n, 0,
+ map {
+ $_->parent($self);
+ $_->index($i++);
+ $_
+ } @_;
+ for (; $i < @{$self->{_tree}}; $i++) {
+ $self->{_tree}[$i]->index($i);
+ }
+}
+
+sub delete_node {
+ my ($self, $n) = @_;
+ splice @{$self->{_tree}}, $n, 1;
+ for (; $n < @{$self->{_tree}}; $n++) {
+ $self->{_tree}[$n]->index($n);
+ }
+ $self->root->mark_dirty;
+}
+
+sub tree {
+ my ($self, $n) = @_;
+ if ($n) {
+ return undef if $n >= @{$self->{_tree}};
+ return $self->{_tree}[$n];
+ }
+ return @{shift->{_tree}}
+};
+
+sub ends_in_empty {
+ my $self = shift;
+ while ($self->is_section) {
+ $self = $self->tree(-1);
+ }
+ return $self->is_empty;
+}
+
+my %match = (
+ name => {
+ wantarg => 1,
+ matcher => sub {
+ my ($node, $value) = @_;
+ return $node->kw && $node->kw eq $value;
+ }
+ },
+ arg => {
+ wantarg => 1,
+ matcher => sub {
+ my ($node, $value) = @_;
+ my $arg = $node->arg($value->{n});
+ return $arg && $arg eq $value->{v};
+ }
+ },
+ section => {
+ matcher => sub {
+ my $node = shift;
+ return $node->is_section;
+ }
+ },
+ statement => {
+ matcher => sub {
+ my $node = shift;
+ return $node->is_statement;
+ }
+ },
+ comment => {
+ matcher => sub {
+ my $node = shift;
+ return $node->is_comment;
+ }
+ }
+);
+
+
+sub select {
+ my $self = shift;
+ my @prog;
+ while (my $p = shift) {
+ my $arg = shift or croak "missing argument";
+ my $m = $match{$p} or croak "unknown matcher: $p";
+ if ($m->{wantarg}) {
+ push @prog, [ $m->{matcher}, $arg ];
+ } elsif ($arg) {
+ push @prog, $m->{matcher};
+ }
+ }
+ grep { _test_node($_, @prog) } $self->tree;
+}
+
+sub _test_node {
+ my $node = shift;
+ foreach my $f (@_) {
+ if (ref($f) eq 'ARRAY') {
+ return 0 unless &{$f->[0]}($node, $f->[1]);
+ } else {
+ return 0 unless &{$f}($node);
+ }
+ }
+ return 1;
+}
+
+1;
+
+
diff --git a/lib/Config/HAProxy/Node/Statement.pm b/lib/Config/HAProxy/Node/Statement.pm
new file mode 100644
index 0000000..abf0e50
--- /dev/null
+++ b/lib/Config/HAProxy/Node/Statement.pm
@@ -0,0 +1,6 @@
+package Config::HAProxy::Node::Statement;
+use parent 'Config::HAProxy::Node';
+
+sub is_statement { 1 }
+
+1;
diff --git a/lib/Config/HAProxy/VirtualHost.pm b/lib/Config/HAProxy/VirtualHost.pm
new file mode 100644
index 0000000..3ad4168
--- /dev/null
+++ b/lib/Config/HAProxy/VirtualHost.pm
@@ -0,0 +1,224 @@
+package Config::HAProxy::VirtualHost;
+use strict;
+use warnings;
+use Carp;
+use File::Spec;
+use Config::HAProxy::Node::Empty;
+
+sub find_file {
+ my ($node, $hostdir) = @_;
+ my $rx = qr($hostdir);
+ my @argv = $node->argv;
+ while (my $arg = shift @argv) {
+ if ($arg eq '-f' && -f $argv[0]) {
+ if ($argv[0] =~ s{^($rx/.+)$}{$1}) {
+ # Untaint the value
+ return $1;
+ } else {
+ last;
+ }
+ }
+ }
+}
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ if (@_ == 2) {
+ my ($node, $hostdir) = @_;
+ $self->{node} = $node;
+ $self->{file} = find_file($node, $hostdir);
+ ($self->{backend}) = $node->root->select(name => 'backend',
+ arg => { n => 0,
+ v => $node->arg(0) });
+ } elsif (@_ == 4) {
+ my ($cmd, $name, $port, $domains) = @_;
+
+ $self->{file} = File::Spec->catfile($cmd->hostdir, $name);
+ unlink $self->{file};
+ $self->add_domain(@$domains);
+
+ my $node = new Config::HAProxy::Node::Statement(
+ kw => 'use_backend',
+ argv => [ $name, qw/if { hdr(host) -f/, $self->{file}, '}' ]);
+ $cmd->frontend->append_node_nonempty($node);
+ $self->{node} = $node;
+
+ $node = new Config::HAProxy::Node::Section(
+ kw => 'backend',
+ argv => [ $name ]);
+ $node->append_node(new Config::HAProxy::Node::Statement(
+ kw => 'server',
+ argv => [
+ 'localhost',
+ '127.0.0.1:'.$port
+ ]));
+ $self->{backend} = $node;
+ unless ($cmd->config->tree->ends_in_empty) {
+ $cmd->config->tree->append_node(new Config::HAProxy::Node::Empty);
+ }
+ $cmd->config->tree->append_node($node);
+ $cmd->config->tree->mark_dirty;
+ $self->mark_dirty;
+ } else {
+ croak "unrecognized arguments";
+ }
+ $self
+}
+
+sub valid {
+ my $self = shift;
+ return $self->file && $self->backend
+}
+
+sub file {
+ my $self = shift;
+ return $self->{file};
+}
+
+sub backend {
+ my $self = shift;
+ return $self->{backend};
+}
+
+sub node {
+ my $self = shift;
+ return $self->{node}
+}
+
+sub name {
+ my $self = shift;
+ return $self->node->arg(0);
+}
+
+sub _domainref {
+ my $self = shift;
+ unless ($self->{domains}) {
+ croak "can't use this method on invalid backend" unless $self->file;
+ if (-e $self->file) {
+ open(my $fd, '<', $self->file)
+ or croak "can't open ".$self->file.": $!";
+ chomp(my @domains = <$fd>);
+ close $fd;
+ $self->{domains} = \@domains;
+ } else {
+ $self->{domains} = [];
+ }
+ }
+ return $self->{domains};
+}
+
+sub domains {
+ my $self = shift;
+ my $dom = $self->_domainref;
+ if (my $n = shift) {
+ return undef unless $n < @$dom;
+ return $dom->[$n]
+ }
+ return @$dom;
+}
+
+sub has_domain {
+ my ($self, $name) = @_;
+ $name = lc $name;
+ $name =~ s/\.$//;
+ foreach my $dom ($self->domains) {
+ return 1 if ($name eq $dom);
+ }
+ return 0
+}
+
+sub normalize_hostnames {
+ map { lc } @_
+}
+
+sub writable {
+ my $self = shift;
+ -w $self->file;
+}
+
+sub add_domain {
+ my $self = shift;
+ push @{$self->_domainref()}, normalize_hostnames(@_);
+ $self->mark_dirty;
+}
+
+sub del_domain {
+ my $self = shift;
+ my @hosts = normalize_hostnames(@_);
+ my %dl;
+ @dl{@hosts} = (1) x @hosts;
+ $self->{domains} = [
+ grep {
+ if ($dl{$_}) {
+ $self->mark_dirty;
+ 0;
+ } else {
+ 1
+ }
+ } @{$self->_domainref()}
+ ];
+}
+
+sub servers {
+ my $self = shift;
+ croak "can't use this method on invalid backend" unless $self->backend;
+ my @ret = map { $_->arg(1) } $self->backend->select(name => 'server');
+ if (@_) {
+ my $n = shift;
+ return undef unless $n < @ret;
+ return $ret[$n];
+ }
+ @ret;
+}
+
+sub is_dirty {
+ my $self = shift;
+ return $self->{dirty}
+}
+
+sub mark_dirty {
+ my $self = shift;
+ $self->{dirty} = 1;
+}
+
+sub clear_dirty {
+ my $self = shift;
+ $self->{dirty} = 0;
+}
+
+sub save {
+ my $self = shift;
+ if ($self->is_dirty) {
+ if ($self->domains == 0) {
+ if (unlink $self->file) {
+ $self->clear_dirty;
+ return;
+ }
+ }
+
+ open(my $fd, '>', $self->file)
+ or croak "can't open ".$self->file." for writing: $!";
+ foreach my $dom ($self->domains) {
+ print $fd $dom,"\n";
+ }
+ close $fd;
+
+ $self->clear_dirty
+ }
+}
+
+sub drop {
+ my $self = shift;
+ $self->node->drop;
+ $self->backend->drop;
+ $self->{domains} = [];
+ $self->mark_dirty;
+}
+
+sub DESTROY {
+ my $self = shift;
+ $self->save()
+}
+
+1;

Return to:

Send suggestions and report system problems to the System administrator.