File Coverage

blib/lib/Net/HAProxy.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


line stmt bran cond sub pod time code
1             package Net::HAProxy;
2             BEGIN {
3 1     1   1022 $Net::HAProxy::VERSION = '0.001';
4             }
5 1     1   550 use Moose;
  0            
  0            
6             use Moose::Util::TypeConstraints;
7             use IO::Socket::UNIX;
8             use IO::Scalar;
9             use Text::CSV;
10             use namespace::autoclean;
11              
12             subtype 'ReadWritableSocket',
13             as 'Str',
14             where { -w $_ && -r $_ && -S $_ },
15             message { "'$_' is not a read/writable socket." };
16              
17             has socket => (is => 'ro', isa => 'ReadWritableSocket', required => 1);
18             has timeout => (is => 'ro', isa => 'Int', default => 1);
19              
20             # ABSTRACT: control HAProxy through a socket
21              
22              
23             sub _send_command {
24             my ($self, $cmd) = @_;
25              
26             my $sock = IO::Socket::UNIX->new(
27             Peer => $self->socket,
28             Type => SOCK_STREAM,
29             Timeout => $self->timeout
30             );
31              
32             $sock->write("$cmd\n");
33             local $/ = undef;
34             my $data = (<$sock>);
35             $sock->close;
36              
37             return $data;
38             }
39              
40              
41             sub stats {
42             my ($self, $args) = @_;
43              
44             my $iid = $args->{iid} || '-1';
45             my $type = $args->{type} || '-1';
46             my $sid = $args->{sid} || '-1';
47              
48             my $data = $self->_send_command("show stat $iid $type $sid");
49              
50             my $sh = IO::Scalar->new(\$data);
51              
52             my $fields = $sh->getline;
53             $fields =~ s/^\# //;
54              
55             my $csv = Text::CSV->new;
56             $csv->parse($fields);
57             $csv->column_names(grep { length } $csv->fields);
58              
59             my $res = $csv->getline_hr_all($sh); pop @$res;
60             return $res;
61             }
62              
63              
64              
65             sub info {
66             my ($self) = @_;
67             my $data = $self->_send_command("show info");
68              
69             my $info = {};
70              
71             for my $line (split /\n/, $data) {
72             chomp $line;
73             next unless length $line;
74             my ($key, $value) = split /:\s+/, $line;
75             $info->{$key} = $value;
76             }
77              
78             return $info;
79             }
80              
81              
82              
83             sub set_weight {
84             my ($self, $pxname, $svname, $weight) = @_;
85              
86             die "Invalid weight must be between 0 and 100"
87             unless $weight > 0 and $weight <= 100;
88              
89             my $response = $self->_send_command("enable server $pxname/$svname $weight\%");
90             chomp $response;
91             die $response if length $response;
92             }
93              
94              
95              
96             sub enable_server {
97             my ($self, $pxname, $svname) = @_;
98             my $response = $self->_send_command("enable server $pxname/$svname");
99             chomp $response;
100             die $response if length $response;
101             }
102              
103              
104             sub disable_server {
105             my ($self, $pxname, $svname) = @_;
106             my $response = $self->_send_command("disable server $pxname/$svname");
107             chomp $response;
108             die $response if length $response;
109             }
110              
111              
112              
113             sub errors {
114             my ($self) = @_;
115             return $self->_send_command("show errors");
116             }
117              
118              
119             sub sessions {
120             my ($self) = @_;
121             return $self->_send_command("show sess");
122             }
123              
124             __PACKAGE__->meta->make_immutable;
125              
126             1;
127              
128             __END__
129             =pod
130              
131             =head1 NAME
132              
133             Net::HAProxy - control HAProxy through a socket
134              
135             =head1 VERSION
136              
137             version 0.001
138              
139             =head1 SYNOPSIS
140              
141             use Try::Tiny;
142             use Net::HAProxy;
143              
144             my $haproxy = Net::HAProxy->new(
145             socket => '/var/run/haproxy-services.sock',
146             timeout => 1 # default
147             );
148              
149             # dump statistics
150             print Dumper $haproxy->stats;
151              
152             # specify which statistics to list
153             print $haproxy->stats({ iid => 2, sid => 1, type => -1});
154              
155             # info about haproxy status
156             print Dumper $haproxy->info;
157              
158             try {
159             $haproxy->enable_server('pxname', 'svname');
160             } catch {
161             print "Couldn't enable server: $_\n";
162             };
163              
164             try {
165             $haproxy->disable_server('pxname', 'svname');
166             } catch {
167             print "Couldn't disable server: $_\n";
168             };
169              
170             try {
171             $haproxy->set_weight('pxname', 'svname', 50);
172             } catch {
173             print "Couldn't set weighting: $_\n";
174             };
175              
176             =head1 METHODS
177              
178             =head2 stats
179              
180             Arguments: ({ iid => -1, sid => -1, type => -1})
181             sid => service id, -1 for all services (default).
182             iid => unique proxy id, -1 for all proxies (default).
183             type => 1 for frontends, 2 for backends, 4 for servers, -1 for all (default)
184              
185             these values can be ORed, for example:
186             1 + 2 = 3 -> frontend + backend.
187             1 + 2 + 4 = 7 -> frontend + backend + server.
188              
189             Returns: array of hashes, keys described below
190              
191             =head2 field descriptions
192              
193             This field documentation was borrowed from the HAProxy 1.4 docs
194             http://haproxy.1wt.eu/download/1.4/doc/configuration.txt
195              
196             If your using an earlier version of HAProxy this should still work, please check the docs for the right field descriptions
197             http://haproxy.1wt.eu/download/1.3/doc/configuration.txt
198              
199             act: server is active (server), number of active servers (backend)
200             bck: server is backup (server), number of backup servers (backend)
201             bin: bytes in
202             bout: bytes out
203             check_code: layer5-7 code, if available
204             check_duration: time in ms took to finish last health check
205             check_status: status of last health check, one of:
206             UNK -> unknown
207             INI -> initializing
208             SOCKERR -> socket error
209             L4OK -> check passed on layer 4, no upper layers testing enabled
210             L4TMOUT -> layer 1-4 timeout
211             L4CON -> layer 1-4 connection problem, for example
212             "Connection refused" (tcp rst) or "No route to host" (icmp)
213             L6OK -> check passed on layer 6
214             L6TOUT -> layer 6 (SSL) timeout
215             L6RSP -> layer 6 invalid response - protocol error
216             L7OK -> check passed on layer 7
217             L7OKC -> check conditionally passed on layer 7, for example 404 with
218             disable-on-404
219             L7TOUT -> layer 7 (HTTP/SMTP) timeout
220             L7RSP -> layer 7 invalid response - protocol error
221             L7STS -> layer 7 response error, for example HTTP 5xx
222             chkdown: number of UP->DOWN transitions
223             chkfail: number of failed checks
224             cli_abrt: number of data transfers aborted by the client
225             downtime: total downtime (in seconds)
226             dreq: denied requests
227             dresp: denied responses
228             econ: connection errors
229             ereq: request errors
230             eresp: response errors (among which srv_abrt)
231             hanafail: failed health checks details
232             hrsp_1xx: http responses with 1xx code
233             hrsp_2xx: http responses with 2xx code
234             hrsp_3xx: http responses with 3xx code
235             hrsp_4xx: http responses with 4xx code
236             hrsp_5xx: http responses with 5xx code
237             hrsp_other: http responses with other codes (protocol error)
238             iid: unique proxy id
239             lastchg: last status change (in seconds)
240             lbtot: total number of times a server was selected
241             pid: process id (0 for first instance, 1 for second, ...)
242             pxname: proxy name
243             qcur: current queued requests
244             qlimit: queue limit
245             qmax: max queued requests
246             rate_lim: limit on new sessions per second
247             rate_max: max number of new sessions per second
248             rate: number of sessions per second over last elapsed second
249             req_rate: HTTP requests per second over last elapsed second
250             req_rate_max: max number of HTTP requests per second observed
251             req_tot: total number of HTTP requests received
252             scur: current sessions
253             sid: service id (unique inside a proxy)
254             slim: sessions limit
255             smax: max sessions
256             srv_abrt: number of data transfers aborted by the server (inc. in eresp)
257             status: status (UP/DOWN/NOLB/MAINT/MAINT(via)...)
258             stot: total sessions
259             svname: service name (FRONTEND for frontend, BACKEND for backend, any name for server)
260             throttle: warm up status
261             tracked: id of proxy/server if tracking is enabled
262             type (0=frontend, 1=backend, 2=server, 3=socket)
263             weight: server weight (server), total weight (backend)
264             wredis: redispatches (warning)
265             wretr: retries (warning)
266              
267             =head2 info
268              
269             returns a hash
270              
271             =head2 set_weight
272              
273             Arguments: proxy name (pxname), service name (svname), integer (0-100)
274              
275             Dies on invalid proxy / service name / weighting
276              
277             =head2 enable_server
278              
279             Arguments: proxy name (pxname), service name (svname)
280              
281             Dies on invalid proxy / service name.
282              
283             =head2 disable_server
284              
285             Arguments: proxy name (pxname), service name (svname)
286              
287             Dies on invalid proxy / service name.
288              
289             =head2 errors (EXPERIMENTAL)
290              
291             list errors, currently returns raw response
292              
293             =head2 sessions (EXPERIMENTAL)
294              
295             show current sessions currently returns raw response
296              
297             =head1 AUTHOR
298              
299             robin edwards <robin.ge@gmail.com>
300              
301             =head1 COPYRIGHT AND LICENSE
302              
303             This software is copyright (c) 2011 by robin edwards.
304              
305             This is free software; you can redistribute it and/or modify it under
306             the same terms as the Perl 5 programming language system itself.
307              
308             =cut
309