← Back to branch summary

~ubuntu-branches/ubuntu/precise/crossroads/precise

« back to all changes in this revision

Viewing changes to test/xr-client-ping

  • Committer: Bazaar Package Importer
  • Author(s): Stefan Ritter
  • Date: 2010-07-05 16:27:00 UTC
  • Revision ID: james.westby@ubuntu.com-20100705162700-0g08tfav8ee9y51u
Tags: upstream-2.65
Import upstream version 2.65

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/xr-client-ping
 
1
#!/usr/bin/perl
 
2
 
 
3
use POSIX ':sys_wait_h';
 
4
use strict;
 
5
 
 
6
# Main
 
7
my $quiet = 0;
 
8
while($ARGV[0] eq '-q') {
 
9
    $quiet++;
 
10
    shift(@ARGV);
 
11
}
 
12
 
 
13
usage() if ($#ARGV != 1);
 
14
my $sleeptime = sprintf('%d', $ARGV[1]);
 
15
die("$0: bad interval $ARGV[1]\n") if ($sleeptime < 2);
 
16
while (1) {
 
17
    # Clean up any zombies
 
18
    while (waitpid(-1, WNOHANG) > 0) { }
 
19
 
 
20
    # Run the test
 
21
    do_test();
 
22
 
 
23
    # Sleep for the duration of the interval
 
24
    my $slept = 0;
 
25
    while ($slept < $sleeptime) {
 
26
        $slept += sleep($sleeptime - $slept);
 
27
    }
 
28
}
 
29
 
 
30
# Show usage and croak
 
31
sub usage() {
 
32
    die <<"ENDUSAGE";
 
33
 
 
34
Usage: xr-client-ping [-q] WEBINTERFACE-URL INTERVAL
 
35
The web interface is queried for clients. Connections to non-pingable clients
 
36
are killed. The process is repeated each interval.
 
37
 
 
38
The arguments:
 
39
  -q: quiet mode, suppresses verbose messaging
 
40
  WEBINTERFACE-URL: the URL of XR's web interface, include http://
 
41
  INTERVAL: number of seconds
 
42
 
 
43
ENDUSAGE
 
44
}
 
45
 
 
46
# Start a single test
 
47
my $_tries = 0;
 
48
sub do_test() {
 
49
    msg ("-----------------------------------------------------------------\n");
 
50
    msg ("Starting check run\n");
 
51
    my $xml;
 
52
    eval {
 
53
        $xml = http_get($ARGV[0]);
 
54
    };
 
55
    if ($@) {
 
56
        msg ("Could not access web interface: $@\n");
 
57
        die ("Too many tries now, giving up...\n") if ($_tries++ > 5);
 
58
        return;
 
59
    }
 
60
    $_tries = 0;
 
61
 
 
62
    my $active = 0;
 
63
    my ($id, $clientip);
 
64
    for my $line (split(/\n/, $xml)) {
 
65
        $active = 1 if ($line =~ /<thread>/);
 
66
        $active = 0 if ($line =~ /<\/thread>/);
 
67
 
 
68
        if ($active) {
 
69
            if ($line =~ /<id>/) {
 
70
                $id = $line;
 
71
                $id =~ s/\s*<id>//;
 
72
                $id =~ s/<\/id>.*//;
 
73
            } elsif ($line =~ /<clientip>/) {
 
74
                $clientip = $line;
 
75
                $clientip =~ s/\s*<clientip>//;
 
76
                $clientip =~ s/<\/clientip>//;
 
77
                check_client($id, $clientip) if ($clientip ne '0.0.0.0');
 
78
            }
 
79
        }
 
80
    }
 
81
}
 
82
 
 
83
# Check one thread ID and client IP
 
84
sub check_client($$) {
 
85
    my ($id, $clientip) = @_;
 
86
 
 
87
 
 
88
    msg ("Checking connection for client $clientip (XR thread $id)\n");
 
89
    return if (fork());
 
90
 
 
91
    my $cmd = "ping -c3 -t3 $clientip >/dev/null";
 
92
    msg ("$clientip: pinging (external '$cmd')\n");
 
93
    my $status = system($cmd);
 
94
    if ($status != 0) {
 
95
        msg ("$clientip: ping status '$status' $!\n");
 
96
        msg ("$clientip: not reachable, stopping XR thread $id\n");
 
97
        eval {
 
98
            http_get("$ARGV[0]/thread/kill/$id");
 
99
        };
 
100
        msg ("Failed to stop thread $id\n") if ($@);
 
101
    } else {
 
102
        msg ("$clientip: reachable, connection assumed valid\n");
 
103
    }
 
104
    exit(0);
 
105
}
 
106
        
 
107
# Do a HTTP GET. Try LWP::UserAgent if available, else try wget.
 
108
sub http_get($) {
 
109
    my $url = shift;
 
110
    my $ua;
 
111
 
 
112
    # Try LWP::UserAgent
 
113
    eval {
 
114
        require LWP::UserAgent;
 
115
    };
 
116
    if (! $@) {
 
117
        $ua = LWP::UserAgent->new();
 
118
        $ua->timeout(3);
 
119
        my $res = $ua->get($url);
 
120
        die ("Could not access url '$url'\n")
 
121
          unless ($res->is_success());
 
122
        return $res->content();
 
123
    }
 
124
 
 
125
    # Try wget or curl, or any other command (can be put in here)
 
126
    for my $cmd ("wget -q -O- -T3 '$url'",
 
127
                 "curl --connect-timeout 3 -s '$url'") {
 
128
        msg ("Running: $cmd\n");
 
129
        open (my $if, "$cmd |");
 
130
        if ($if) {
 
131
            my $cont = '';
 
132
            while (my $line = <$if>) {
 
133
                $cont .= $line;
 
134
            }
 
135
            if (close($if)) {
 
136
                return $cont;
 
137
            } else {
 
138
                msg("$cmd failed: $!\n");
 
139
            }
 
140
        }
 
141
    }
 
142
 
 
143
    # All failed, now what?
 
144
    die ("No method to access url '$url'\n");
 
145
}
 
146
    
 
147
# Verbose messaging
 
148
sub msg {
 
149
    print ($$, ' ', scalar(localtime()), ' ', @_) unless ($quiet);
 
150
}