#!/usr/bin/perl # # rhrdweb # # Copyright (C) 2016 Christian Pointner # # This file is part of rhrdweb. # # rhrdweb is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as published by # the Free Software Foundation, either version 3 of the License, or # any later version. # # rhrdweb is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Affero General Public License for more details. # # You should have received a copy of the GNU Affero General Public License # along with rhrdweb. If not, see . # use strict; use RHRD::rddb; use JSON::MaybeXS; use IO::Socket; use Socket qw(SOCK_STREAM getaddrinfo); my $status = 'ERROR'; my $errorstring = 'unknown'; my $responsecode = 500; my $system = 'unknown'; my %hints = (socktype => SOCK_STREAM); my ($err, @res) = getaddrinfo("rhctl.helsinki.at", "2345", \%hints); if($err) { $errorstring = "Cannot getaddrinfo - $err"; } else { my $sock; foreach my $ai (@res) { my $candidate = IO::Socket->new(); $candidate->socket($ai->{family}, $ai->{socktype}, $ai->{protocol}) or next; $candidate->connect($ai->{addr}) or next; $sock = $candidate; last; } if($sock) { $system = <$sock>; $system =~ s/\s+$//; $status = 'OK'; $errorstring = 'success'; $responsecode = 200; close($sock); } else { $errorstring = "Cannot connect to rhctl.helsinki.at:2345"; } } my %answer; $answer{'status'} = $status; $answer{'errorstring'} = $errorstring; $answer{'system'} = $system; my $j = JSON::MaybeXS->new(utf8 => 0); print "Content-type: application/json; charset=UTF-8\n"; print "Status: $responsecode\n\n"; print $j->encode(\%answer);