MMCLERIC / Ubic-1.37 / lib / Ubic / Ping.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
—
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

              
#!/usr/bin/perl
package Ubic::Ping;
BEGIN {
  $Ubic::Ping::VERSION = '1.37';
}
use strict;
use warnings;
# ABSTRACT: http server which returns service status by it's name or port
use Ubic;
use Ubic::PortMap;
use Params::Validate qw(:all);
use Try::Tiny;
use parent qw(HTTP::Server::Simple::CGI);
sub _print_status($;$) {
    my ($name, $options) = validate_pos(@_, 1, { type => HASHREF, default => {} });
    unless (Ubic->is_enabled($name)) {
        if ($options->{noc}) {
            print "HTTP/1.0 500 Disabled\r\n\r\n";
        }
        else {
            print "HTTP/1.0 200 OK\r\n\r\n";
        }
        print "disabled\n";
        return;
    }
    my $status = Ubic->cached_status($name)->status; # should read status from static file on disk
    if ($status eq 'running') {
        print "HTTP/1.0 200 OK\r\n\r\n";
        print "ok\n";
        return;
    }
    else {
        if ($options->{noc}) {
            if ($status =~ /^[\w ]+$/) {
                print "HTTP/1.0 500 $status\r\n\r\n";
            }
            else {
                # invalid status, fallback to default status message
                print "HTTP/1.0 500 Wrong status\r\n\r\n";
            }
        }
        else {
            print "HTTP/1.0 200 OK\r\n\r\n";
        }
        print "$status\n";
        return;
    }
}
sub handle_request {
    my ($self, $cgi) = @_;
    try {
        if ($cgi->path_info eq '/ping') {
            # ping self
            print "HTTP/1.0 200 OK\r\n\r\n";
            print "ok\n";
            return;
        }
        elsif ( $cgi->path_info =~ m{^/noc/(\d+)/?$}) {
            my $port = $1;
            my $name = Ubic::PortMap::port2name($port);
            unless (defined $name) {
                print "HTTP/1.0 404 Not found\r\n\r\n";
                print "Service at port '$port' not found\n";
                return;
            }
            _print_status($name, { noc => 1 });
            return;
        }
        elsif ($cgi->path_info =~ m{^/status/port/(\d+)/?$}) {
            my $port = $1;
            my $name = Ubic::PortMap::port2name($port);
            unless (defined $name) {
                print "HTTP/1.0 404 Not found\r\n\r\n";
                print "Service at port '$port' not found\n";
                return;
            }
            _print_status($name);
            return;
        }
        elsif (my ($name) = $cgi->path_info =~ m{^/status/service/(.+?)/?$}) {
            unless (Ubic->has_service($name)) {
                print "HTTP/1.0 404 Not found\r\n\r\n";
                print "Service with name '$name' not found\n";
                return;
            }
            _print_status($name);
        }
        else {
            print "HTTP/1.0 404 Not found\r\n\r\n";
            print "Expected /status/service/NAME or /status/port/PORT query\n";
            return;
        }
    }
    catch {
        print "HTTP/1.0 500 Internal error\r\n\r\n";
        print "Error: $_";
    };
}
1;
__END__
=pod
=head1 NAME
Ubic::Ping - http server which returns service status by it's name or port
=head1 VERSION
version 1.37
=head1 AUTHOR
Vyacheslav Matyukhin <mmcleric@yandex-team.ru>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Yandex LLC.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut