├── .github └── workflows │ ├── build-test.yaml │ ├── release.yaml │ └── stale.yaml ├── .gitignore ├── CHANGES ├── CONTRIBUTORS ├── COPYRIGHT ├── HACKING ├── LICENSE ├── Makefile.am ├── README.md ├── TODO ├── VERSION ├── bin ├── Makefile.am ├── smokeinfo ├── smokeping ├── smokeping_cgi └── tSmoke ├── bootstrap ├── configure.ac ├── cpanfile ├── doc ├── Makefile.am ├── smokeping_extend.pod ├── smokeping_install.pod ├── smokeping_master_slave.pod └── smokeping_upgrade.pod ├── etc ├── Makefile.am ├── basepage.html.dist ├── config.dist.in ├── smokemail.dist ├── smokeping_secrets.dist └── tmail.dist ├── htdocs ├── Makefile.am ├── css │ ├── smokeping-print.css │ └── smokeping-screen.css ├── js │ ├── cropper │ │ ├── cropper.css │ │ ├── cropper.js │ │ ├── cropper.uncompressed.js │ │ ├── licence.txt │ │ ├── marqueeHoriz.gif │ │ └── marqueeVert.gif │ ├── prototype.js │ ├── scriptaculous │ │ ├── builder.js │ │ ├── controls.js │ │ ├── dragdrop.js │ │ ├── effects.js │ │ ├── scriptaculous.js │ │ ├── slider.js │ │ ├── sound.js │ │ └── unittest.js │ └── smokeping.js └── smokeping.fcgi.dist ├── lib ├── BER.pm ├── Makefile.am ├── SNMP_Session.pm ├── SNMP_util.pm ├── Smokeping.pm └── Smokeping │ ├── Colorspace.pm │ ├── Config.pm │ ├── Examples.pm │ ├── Graphs.pm │ ├── Info.pm │ ├── Master.pm │ ├── RRDhelpers.pm │ ├── RRDtools.pm │ ├── Slave.pm │ ├── ciscoRttMonMIB.pm │ ├── matchers │ ├── Avgratio.pm │ ├── CheckLatency.pm │ ├── CheckLoss.pm │ ├── ConsecutiveLoss.pm │ ├── ExpLoss.pm │ ├── Median.pm │ ├── Medratio.pm │ └── base.pm │ ├── pingMIB.pm │ ├── probes │ ├── AnotherCurl.pm │ ├── AnotherDNS.pm │ ├── AnotherSSH.pm │ ├── CiscoRTTMonDNS.pm │ ├── CiscoRTTMonEchoICMP.pm │ ├── CiscoRTTMonTcpConnect.pm │ ├── Curl.pm │ ├── DNS.pm │ ├── DismanPing.pm │ ├── EchoPing.pm │ ├── EchoPingChargen.pm │ ├── EchoPingDNS.pm │ ├── EchoPingDiscard.pm │ ├── EchoPingHttp.pm │ ├── EchoPingHttps.pm │ ├── EchoPingIcp.pm │ ├── EchoPingLDAP.pm │ ├── EchoPingPlugin.pm │ ├── EchoPingSmtp.pm │ ├── EchoPingWhois.pm │ ├── FPing.pm │ ├── FPing6.pm │ ├── FPingContinuous.pm │ ├── FTPtransfer.pm │ ├── IOSPing.pm │ ├── IRTT.pm │ ├── LDAP.pm │ ├── NFSping.pm │ ├── OpenSSHEOSPing.pm │ ├── OpenSSHJunOSPing.pm │ ├── Qstat.pm │ ├── Radius.pm │ ├── RemoteFPing.pm │ ├── SSH.pm │ ├── SendEmail.pm │ ├── SipSak.pm │ ├── TCPPing.pm │ ├── TacacsPlus.pm │ ├── TelnetIOSPing.pm │ ├── TelnetJunOSPing.pm │ ├── TraceroutePing.pm │ ├── WebProxyFilter.pm │ ├── base.pm │ ├── basefork.pm │ ├── basevars.pm │ ├── passwordchecker.pm │ └── skel.pm │ └── sorters │ ├── Loss.pm │ ├── Max.pm │ ├── Median.pm │ ├── StdDev.pm │ └── base.pm ├── thirdparty └── Makefile.am ├── update-changes.sh └── util └── fix-pod2html.pl /.github/workflows/build-test.yaml: -------------------------------------------------------------------------------- 1 | name: Build Test 2 | 3 | on: 4 | push: 5 | branches: 6 | - master 7 | pull_request: 8 | branches: 9 | - master 10 | 11 | jobs: 12 | build: 13 | strategy: 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | # - windows-latest 18 | # - macos-latest 19 | # no libssl on windows 20 | # - windows-latest 21 | fail-fast: false 22 | name: ${{ matrix.os }} 23 | runs-on: ${{ matrix.os }} 24 | 25 | steps: 26 | - name: Checkout 27 | uses: actions/checkout@v3 28 | 29 | - name: CPAN Cache 30 | id: cpan-cache 31 | uses: actions/cache@v3 32 | with: 33 | path: thirdparty 34 | key: ${{ matrix.os }}-cpan-{{ hashFiles('**/cpanfile') }} 35 | 36 | - name: Install dependencies 37 | run: sudo apt-get install librrds-perl rrdtool dma 38 | 39 | - name: Bootstrap 40 | run: ./bootstrap 41 | 42 | - name: Configure 43 | run: ./configure --prefix=$HOME/test-install 44 | 45 | - name: Make 46 | run: make 47 | 48 | - name: Dist 49 | run: make dist 50 | 51 | - name: Check Dist 52 | run: | 53 | make dist 54 | tar xf *-$(cat VERSION).tar.gz 55 | cd *-$(cat VERSION) 56 | ./configure --prefix=$HOME/test-install 57 | cp -rp ../thirdparty/lib thirdparty/ 58 | make 59 | make install 60 | cd $HOME/test-install 61 | ./bin/smokeping --version 62 | 63 | - name: Cache Prep 64 | run: | 65 | rm -rf thirdparty/Makefile* thirdparty/work 66 | -------------------------------------------------------------------------------- /.github/workflows/release.yaml: -------------------------------------------------------------------------------- 1 | name: Create Release 2 | 3 | on: 4 | workflow_dispatch: 5 | inputs: 6 | confirm_release: 7 | description: 'Type "release" to confirm you want to create a release' 8 | required: true 9 | default: '' 10 | 11 | jobs: 12 | prepare-and-validate: 13 | runs-on: ubuntu-latest 14 | if: github.ref == 'refs/heads/master' && inputs.confirm_release == 'release' 15 | outputs: 16 | version: ${{ steps.extract-version.outputs.version }} 17 | release_notes: ${{ steps.extract-release-notes.outputs.release_notes }} 18 | is_valid: ${{ steps.validate-conditions.outputs.is_valid }} 19 | steps: 20 | - name: Checkout code 21 | uses: actions/checkout@v4 22 | with: 23 | fetch-depth: 0 24 | 25 | - name: Extract version from VERSION file 26 | id: extract-version 27 | run: | 28 | VERSION_CONTENT=$(cat VERSION) 29 | echo "version=$VERSION_CONTENT" >> $GITHUB_OUTPUT 30 | echo "Found version: $VERSION_CONTENT" 31 | 32 | - name: Validate release conditions 33 | id: validate-conditions 34 | run: | 35 | # Get version from VERSION file 36 | VERSION_CONTENT=$(cat VERSION) 37 | 38 | # Get current date in YYYY-MM-DD format 39 | CURRENT_DATE=$(date +%Y-%m-%d) 40 | 41 | # Check first line of CHANGES file contains current date using Perl 42 | DATE_CHECK=$(perl -ne 'if ($. == 1 && /'"$CURRENT_DATE"'/) { print "yes"; exit; } exit if $. > 1;' CHANGES) 43 | 44 | echo "Checking conditions:" 45 | echo "1. On master branch: ${{ github.ref == 'refs/heads/master' }}" 46 | echo "2. First line of CHANGES contains today's date ($CURRENT_DATE)" 47 | echo " First line check result: $DATE_CHECK" 48 | 49 | if [[ "$DATE_CHECK" == "yes" ]]; then 50 | echo "All conditions met!" 51 | echo "is_valid=true" >> $GITHUB_OUTPUT 52 | else 53 | echo "Release conditions not met:" 54 | echo "CHANGES first line should contain today's date: $CURRENT_DATE" 55 | echo "is_valid=false" >> $GITHUB_OUTPUT 56 | exit 1 57 | fi 58 | 59 | - name: Extract release notes 60 | id: extract-release-notes 61 | run: | 62 | # Create a temporary file to store the release notes 63 | TEMP_FILE=$(mktemp) 64 | 65 | # Extract the entire first section of CHANGES file using Perl and save to temp file 66 | perl -0777 -ne ' 67 | if (/^((\d{4}-\d{2}-\d{2}).*?)(?=^\d{4}-\d{2}-\d{2}|\z)/ms) { 68 | print $1; 69 | } 70 | ' CHANGES > "$TEMP_FILE" 71 | 72 | # Use GitHub's approach for multiline outputs 73 | echo "release_notes<> $GITHUB_OUTPUT 74 | cat "$TEMP_FILE" >> $GITHUB_OUTPUT 75 | echo "EOF" >> $GITHUB_OUTPUT 76 | 77 | # Also save the release notes as an artifact for debugging 78 | mkdir -p release_artifacts 79 | cp "$TEMP_FILE" release_artifacts/release_notes.txt 80 | 81 | - name: Upload release notes for debugging 82 | uses: actions/upload-artifact@v4 83 | with: 84 | name: release-notes 85 | path: release_artifacts/ 86 | 87 | build-and-release: 88 | needs: prepare-and-validate 89 | if: needs.prepare-and-validate.outputs.is_valid == 'true' 90 | runs-on: ubuntu-latest 91 | steps: 92 | - name: Checkout code 93 | uses: actions/checkout@v4 94 | with: 95 | fetch-depth: 0 96 | 97 | - name: Set up build environment 98 | run: | 99 | sudo apt-get update 100 | sudo apt-get install -y build-essential autoconf automake librrds-perl rrdtool dma 101 | 102 | - name: Build project 103 | run: | 104 | ./bootstrap 105 | ./configure --enable-maintainer-mode 106 | make 107 | make clean 108 | make install 109 | make dist 110 | 111 | - name: Configure Git 112 | run: | 113 | git config user.name "GitHub Actions" 114 | git config user.email "actions@github.com" 115 | 116 | - name: Create and push tag 117 | run: | 118 | VERSION=${{ needs.prepare-and-validate.outputs.version }} 119 | TAG_NAME="v$VERSION" 120 | 121 | # Check if tag already exists 122 | if git rev-parse "$TAG_NAME" >/dev/null 2>&1; then 123 | echo "Tag $TAG_NAME already exists" 124 | exit 1 125 | else 126 | echo "Creating tag $TAG_NAME" 127 | git tag -a "$TAG_NAME" -m "Release $TAG_NAME" 128 | git push origin "$TAG_NAME" 129 | fi 130 | 131 | - name: Create GitHub Release 132 | id: create_release 133 | uses: softprops/action-gh-release@v2 134 | with: 135 | tag_name: v${{ needs.prepare-and-validate.outputs.version }} 136 | files: smokeping-${{ needs.prepare-and-validate.outputs.version }}.tar.gz 137 | name: Release v${{ needs.prepare-and-validate.outputs.version }} 138 | body: | 139 | ${{ needs.prepare-and-validate.outputs.release_notes }} 140 | draft: false 141 | prerelease: false 142 | env: 143 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 144 | -------------------------------------------------------------------------------- /.github/workflows/stale.yaml: -------------------------------------------------------------------------------- 1 | name: Mark stale issues and pull requests 2 | # https://github.com/actions/stale 3 | on: 4 | schedule: 5 | - cron: "21 4 * * *" 6 | 7 | jobs: 8 | stale: 9 | 10 | runs-on: ubuntu-latest 11 | 12 | steps: 13 | - uses: actions/stale@v3 14 | with: 15 | stale-issue-message: 'This issue has become stale and will be closed automatically within 7 days. Comment on the issue to keep it alive.' 16 | stale-pr-message: 'This pull request has become stale and will be closed automatically within 7 days. Comment on the PR to keep it alive.' 17 | stale-issue-label: 'no-issue-activity' 18 | stale-pr-label: 'no-pr-activity' 19 | days-before-stale: 90 20 | days-before-issue-close: 7 21 | days-before-pr-close: 7 -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | Makefile 3 | Makefile.in 4 | config.status 5 | configure 6 | config.log 7 | aclocal.m4 8 | DEADJOE 9 | autom4te.cache/ 10 | conftools/ 11 | smokeping-*.tar.gz 12 | doc/examples 13 | doc/*.[1-9] 14 | doc/smokeping_config.pod 15 | doc/smokeping_examples.pod 16 | doc/smokeping_install.txt 17 | etc/config.dist 18 | thirdparty/* 19 | !thirdparty/ 20 | !thirdparty/Makefile.am 21 | *-*.*.*/ 22 | *.gz -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Contributors 2 | ============ 3 | 4 | * Tobias Oetiker => Main Author 5 | 6 | * Niko Tyni => Many Patches 7 | * Simon Leinen => SNMP_Session.pm 8 | * David Schweikert => Config::Grammar 9 | * Jack Cummings => Proper graphs with pings > 10s. 10 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | SmokePing - a ICMP latency logging and graphing 2 | system. It consists of a daemon process which 3 | organizes the latency measurements and a CGI which 4 | presents the graphs. 5 | 6 | Copyright (c) 2001 Tobias Oetiker 7 | 8 | All rights reserved. 9 | 10 | This program is free software; you can redistribute it and/or modify it 11 | under the terms of the GNU General Public License as published by the Free 12 | Software Foundation; either version 2 of the License, or (at your option) 13 | any later version. 14 | 15 | This program is distributed in the hope that it will be useful, but WITHOUT 16 | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 17 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 18 | more details. 19 | 20 | You should have received a copy of the GNU General Public License along 21 | with this program; if not, write to the Free Software Foundation, Inc., 22 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA. 23 | -------------------------------------------------------------------------------- /HACKING: -------------------------------------------------------------------------------- 1 | SmokePing Hacking 2 | ----------------- 3 | 4 | The source of SmokePing lives on 5 | 6 | https://github.com/oetiker/SmokePing 7 | 8 | If you come up with new and cool features, send a pull request. 9 | 10 | If you find a bug, report it on GitHub as an issue. 11 | 12 | If you are planning to implement something large, 13 | please discuss it on the smokeping-users mailinglist. 14 | 15 | -------------------------------------------------------------------------------- /Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2011 Tobias Oetiker 2 | # 3 | # This program is free software; you can redistribute it and/or modify 4 | # it under the terms of the GNU General Public License as published by 5 | # the Free Software Foundation; either version 2 of the License, or 6 | # (at your option) any later version. 7 | # 8 | # This program is distributed in the hope that it will be useful, 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | # GNU General Public License for more details. 12 | # 13 | # You should have received a copy of the GNU General Public License 14 | # along with this program; if not, write to the Free Software 15 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 16 | 17 | AUTOMAKE_OPTIONS = foreign 18 | 19 | SUBDIRS = lib thirdparty bin doc etc htdocs 20 | 21 | EXTRA_DIST = COPYRIGHT CHANGES CONTRIBUTORS LICENSE cpanfile VERSION README.md 22 | 23 | dist-hook: 24 | $(PERL) -i -p -e '"$(PACKAGE_VERSION)" =~ /(\d+)\.(\d+)\.(\d+)/ and $$v = sprintf("%d.%03d%03d",$$1,$$2,$$3) and s/^\$$VERSION\s*=\s*".*?"/\$$VERSION = "$$v"/' $(distdir)/lib/Smokeping.pm 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ``` 2 | ____ _ ____ _ 3 | / ___| _ __ ___ ___ | | _____| _ \(_)_ __ __ _ 4 | \___ \| '_ ` _ \ / _ \| |/ / _ \ |_) | | '_ \ / _` | 5 | ___) | | | | | | (_) | < __/ __/| | | | | (_| | 6 | |____/|_| |_| |_|\___/|_|\_\___|_| |_|_| |_|\__, | 7 | |___/ 8 | ``` 9 | 10 | Original Authors: Tobias Oetiker and Niko Tyni 11 | 12 | [![Build Test](https://github.com/oetiker/SmokePing/actions/workflows/build-test.yaml/badge.svg)](https://github.com/oetiker/SmokePing/actions/workflows/build-test.yaml) 13 | 14 | SmokePing is a latency logging and graphing and 15 | alerting system. It consists of a daemon process which 16 | organizes the latency measurements and a CGI which 17 | presents the graphs. 18 | 19 | SmokePing is ... 20 | ================ 21 | 22 | * extensible through plug-in modules 23 | 24 | * easy to customize through a webtemplate and an extensive 25 | configuration file. 26 | 27 | * written in perl and should readily port to any unix system 28 | 29 | * an RRDtool frontend 30 | 31 | * able to deal with DYNAMIC IP addresses as used with 32 | Cable and ADSL internet. 33 | 34 | 35 | cheers 36 | tobi 37 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | * ALERTS based on input from multiple targets 2 | Wouter Prins 3 | 4 | 5 | * ASSIGN BLAME - HALFWAY PING 6 | - A method for pinging the host in the middle between here and host B 7 | (use traceroute for figuring out which one it should be) 8 | This graph combined with the graph for here-B could show in which half of the link the problem lies ... 9 | Russell Stuart 10 | 11 | * TOP10 12 | - show a list of the top 10 (most whatever graphs) 13 | gmourani * privalodc.com 14 | < they are willing to pay for this feature - tobi > 15 | 16 | * UPTIME 17 | - define update via snmp pointer per device 18 | - possibility to call an external script 19 | -> generic uptime plugin? 20 | 21 | * ATTENTION 22 | allow to define a threshold rule by looking at 23 | two average medians and take action when threshold triped 24 | 25 | * ALIASES 26 | allow to have atarget which points to a different target 27 | only targets with host are considered 28 | 29 | * ALERTS 30 | make 'active alerts' (whatever that means, have to think 31 | this through) visible (eg. different colour) in the CGI menu 32 | - suggested by Cornel Badea 33 | 34 | Targets/alertee: syntax to remove an address from the Alerts/to list 35 | (maybe 'alertee = -user@somewhere'? This breaks real addresses 36 | starting with '-'...require quoting for those?) 37 | - from James Bouressa, 38 | 39 | * REMOTE EXECUTION 40 | generic remote probe 41 | - a possibility for basefork-derived probes to reuse the same 42 | SSH connection with shell for() loops for all the pings to a given 43 | target 44 | 45 | * GENERIC EXEC PROBE 46 | - almost every probe has a different way of calling system(), exec() 47 | or similar. This should be in an inheritable module. 48 | - the module should also support extra commandline arguments 49 | 50 | * RRD 51 | configurable RRD parameters per target? 52 | - suggested by Leos Bitto, 53 | 54 | 55 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 2.9.0 2 | -------------------------------------------------------------------------------- /bin/Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2011 Tobias Oetiker 2 | # 3 | # This program is free software; you can redistribute it and/or modify 4 | # it under the terms of the GNU General Public License as published by 5 | # the Free Software Foundation; either version 2 of the License, or 6 | # (at your option) any later version. 7 | # 8 | # This program is distributed in the hope that it will be useful, 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | # GNU General Public License for more details. 12 | # 13 | # You should have received a copy of the GNU General Public License 14 | # along with this program; if not, write to the Free Software 15 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 16 | 17 | 18 | dist_bin_SCRIPTS = smokeinfo smokeping smokeping_cgi tSmoke 19 | 20 | install-exec-hook: 21 | test "$(PERL5LIB)" = "" || cd "$(DESTDIR)$(bindir)" && $(PERL) -i -p -e 's{.*# PERL5LIB}{use lib (split /:/, q{$(PERL5LIB)}); # PERL5LIB}' $(dist_bin_SCRIPTS) 22 | cd "$(DESTDIR)$(bindir)" && $(PERL) -i -p -e 's{.*# LIBDIR}{use lib qw($(libdir)); # LIBDIR}' $(dist_bin_SCRIPTS) 23 | cd "$(DESTDIR)$(bindir)" && $(PERL) -i -p -e 's{^#!.*perl.*}{#!$(PERL)};' $(dist_bin_SCRIPTS) 24 | # EOF 25 | -------------------------------------------------------------------------------- /bin/smokeinfo: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use lib (split /:/, q{}); # PERL5LIB 6 | use FindBin;use lib "$FindBin::RealBin/../lib";use lib "$FindBin::RealBin/../thirdparty/lib/perl5"; # LIBDIR 7 | 8 | use Smokeping::Info; 9 | use Getopt::Long 2.25 qw(:config no_ignore_case); 10 | use Pod::Usage 1.14; 11 | 12 | '$Revision: 3879 $ ' =~ /Revision: (\S*)/; 13 | my $Revision = $1; 14 | 15 | sub main() 16 | { 17 | # parse options 18 | my %opt = (mode=>'plain',separator=>';',format=>'%le',start=>'end-24h',end=>'now'); 19 | 20 | GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n','no-head', 21 | 'start=s','end=s','filter=s','mode=s','separator=s','format=s') or exit(1); 22 | if($opt{help}) { pod2usage(1) } 23 | if($opt{man}) { pod2usage(-exitstatus => 0, -verbose => 2) } 24 | if($opt{version}) { print "smokeinfo $Revision\n"; exit(0) } 25 | if($opt{noaction}) { die "ERROR: don't know how to \"no-action\".\n" } 26 | my $config = shift @ARGV; 27 | 28 | my $si = Smokeping::Info->new($config); 29 | my $nodes = $si->fetch_nodes(pattern=>$opt{filter},mode=>$opt{mode}); 30 | my @rows = qw(med_avg med_min med_max med_now loss_avg loss_max loss_now); 31 | print '# ',join $opt{separator}, 'node_path',@rows if not $opt{'no-head'}; 32 | print "\n"; 33 | for my $node (@$nodes) { 34 | my $data = $si->stat_node($node,$opt{start},$opt{end}); 35 | print join $opt{separator},$node->{path},map {defined $data->{$_} ? sprintf($opt{format},$data->{$_}) : '?'} @rows; 36 | print "\n"; 37 | } 38 | } 39 | 40 | main; 41 | 42 | __END__ 43 | 44 | =head1 NAME 45 | 46 | smokeinfo - poll smokeping site for numeric information 47 | 48 | =head1 SYNOPSIS 49 | 50 | B path/to/config.cfg [I] 51 | 52 | --start x rrd graph start time. (default now-24h) 53 | 54 | --end y rrd graph end time. (default now) 55 | 56 | --filter pattern search pattern for node selection 57 | 58 | --mode plain (default) how to use the pattern 59 | - plain 60 | - recursive 61 | - regexp 62 | 63 | --separator ; (default) 64 | 65 | --format %le (default) 66 | 67 | --no-head do not print a header 68 | 69 | --man show man-page and exit 70 | -h, --help display this help and exit 71 | --version output version information and exit 72 | 73 | =head1 DESCRIPTION 74 | 75 | SmokeInfo is a simple frontend to the L module. It provides 76 | access to numeric data stored in the rrd files. 77 | 78 | Note that --start and --end are passed directly to rrd graph. This means 79 | they work on the same syntax. 80 | 81 | =head2 Examples 82 | 83 | Get all data all nodes 84 | 85 | smokeinfo etc/config 86 | 87 | Only show nodes directly under /Customers 88 | 89 | smokeinfo --filter=/Customers/ etc/config 90 | 91 | Show all nodes under /Customers 92 | 93 | smokeinfo --mode=recursive --filter=/Customers/ etc/config 94 | 95 | Show all nodes with '_wlan_' in the name 96 | 97 | smokeinfo --mode=regexp --filter=_wlan_ etc/config 98 | 99 | =head1 SEE ALSO 100 | 101 | L 102 | 103 | =head1 COPYRIGHT 104 | 105 | Copyright (c) 2009 by OETIKER+PARTNER AG. All rights reserved. 106 | 107 | =head1 LICENSE 108 | 109 | This program is free software; you can redistribute it and/or modify 110 | it under the terms of the GNU General Public License as published by 111 | the Free Software Foundation; either version 2 of the License, or 112 | (at your option) any later version. 113 | 114 | This program is distributed in the hope that it will be useful, 115 | but WITHOUT ANY WARRANTY; without even the implied warranty of 116 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 117 | GNU General Public License for more details. 118 | 119 | You should have received a copy of the GNU General Public License 120 | along with this program; if not, write to the Free Software 121 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 122 | 123 | =head1 AUTHOR 124 | 125 | Stobi@oetiker.chE> 126 | 127 | =head1 HISTORY 128 | 129 | 2009-01-05 to Initial Version 130 | 131 | =cut 132 | 133 | # Emacs Configuration 134 | # 135 | # Local Variables: 136 | # mode: cperl 137 | # eval: (cperl-set-style "PerlStyle") 138 | # mode: flyspell 139 | # mode: flyspell-prog 140 | # End: 141 | # 142 | # vi: sw=4 et 143 | 144 | -------------------------------------------------------------------------------- /bin/smokeping_cgi: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # -*-perl-*- 3 | 4 | use strict; 5 | use warnings; 6 | 7 | use FindBin; 8 | use lib (split /:/, q{}); # PERL5LIB 9 | use lib "$FindBin::RealBin/../lib";use lib "$FindBin::RealBin/../thirdparty/lib/perl5"; # LIBDIR 10 | 11 | # don't bother with zombies 12 | $SIG{CHLD} = 'IGNORE'; 13 | 14 | use CGI::Carp qw(fatalsToBrowser); 15 | 16 | use Smokeping; 17 | 18 | use CGI::Fast; 19 | 20 | my $cfg = (shift @ARGV) || "$FindBin::Bin/../etc/config"; 21 | 22 | 23 | while (my $q = new CGI::Fast) { 24 | Smokeping::cgi($cfg,$q); 25 | } 26 | 27 | =head1 NAME 28 | 29 | smokeping_cgi - SmokePing webfrontend 30 | 31 | =head1 OVERVIEW 32 | 33 | This script acts as a 'website' for your SmokePing monitoring operation. It 34 | presents the targets you are looking at in a tree structure and draws graphs 35 | as they are required by people looking at the pages. 36 | 37 | =head1 DESCRIPTION 38 | 39 | To get B going, you need a webserver which allows you to run 40 | CGI or better FastCGI scripts. The system must be setup so that the cgi 41 | process is allowed to write to the image caching area as defined in the 42 | config file. 43 | 44 | This script runs fine as a normal CGI, B it will appear to be very slow, 45 | because it does a lot of things when starting up. So if the script has to be 46 | started a fresh on every click, this is both slow and a tough thing for your 47 | webserver. I therefore strongly recommend using FastCGI. 48 | 49 | Please refer to the installation document for detailed setup instructions. 50 | 51 | =head1 SETUP 52 | 53 | There is a sample F directory in your smokeping installation root. 54 | Copy its content to the place where your webserver expects its files. The 55 | fcgi script shows the preferred method for running smokeping. You can also 56 | run smokeping as a cgi. But make sure to still use the wrapper as exposing 57 | ARGV to the webserver represents a security vulnerability you may rather not 58 | want to deal with. 59 | 60 | Adjust the paths in the script and you should be ready to go. 61 | 62 | =head1 SEE ALSO 63 | 64 | L, L, L, 65 | L 66 | 67 | =head1 COPYRIGHT 68 | 69 | Copyright (c) 2011 by Tobias Oetiker. All right reserved. 70 | 71 | =head1 LICENSE 72 | 73 | This program is free software; you can redistribute it 74 | and/or modify it under the terms of the GNU General Public 75 | License as published by the Free Software Foundation; either 76 | version 2 of the License, or (at your option) any later 77 | version. 78 | 79 | This program is distributed in the hope that it will be 80 | useful, but WITHOUT ANY WARRANTY; without even the implied 81 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 82 | PURPOSE. See the GNU General Public License for more 83 | details. 84 | 85 | You should have received a copy of the GNU General Public 86 | License along with this program; if not, write to the Free 87 | Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 88 | 02139, USA. 89 | 90 | =head1 AUTHOR 91 | 92 | Tobias Oetiker Etobi@oetiker.chE 93 | 94 | =cut 95 | -------------------------------------------------------------------------------- /bootstrap: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | autoreconf --force --install --verbose --make 3 | # end 4 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2021 Tobi Oetiker 2 | # 3 | # This program is free software; you can redistribute it and/or modify 4 | # it under the terms of the GNU General Public License as published by 5 | # the Free Software Foundation; either version 2 of the License, or 6 | # (at your option) any later version. 7 | # 8 | # This program is distributed in the hope that it will be useful, 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | # GNU General Public License for more details. 12 | # 13 | # You should have received a copy of the GNU General Public License 14 | # along with this program; if not, write to the Free Software 15 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 16 | 17 | # 18 | 19 | 20 | AC_INIT([smokeping],m4_esyscmd([tr -d '\n' < VERSION]),[tobi@oetiker.ch]) 21 | AC_PREREQ([2.71]) 22 | AC_CONFIG_AUX_DIR(conftools) 23 | 24 | # need this to allow long path names 25 | AM_INIT_AUTOMAKE([1.9 tar-ustar foreign]) 26 | 27 | AC_PREFIX_DEFAULT(/opt/$PACKAGE_NAME-$PACKAGE_VERSION) 28 | 29 | AC_ARG_VAR(PERL, [Path to local perl binary]) 30 | AC_PATH_PROG(PERL, perl, no) 31 | AC_PATH_PROG(CURL, curl, no) 32 | AC_PATH_PROG(WGET, wget, no) 33 | 34 | URL_CAT="neither curl nor wget found" 35 | 36 | if test -x "$CURL"; then 37 | URL_CAT="$CURL --location" 38 | else 39 | if test -x "$WGET"; then 40 | URL_CAT="$WGET -O -" 41 | fi 42 | fi 43 | 44 | AC_SUBST(URL_CAT) 45 | 46 | ac_perl_version="5.10.1" 47 | 48 | if test "x$PERL" != "x"; then 49 | AC_MSG_CHECKING(for perl version greater than or equal to $ac_perl_version) 50 | $PERL -e "use $ac_perl_version;" >/dev/null 2>&1 51 | if test $? -ne 0; then 52 | AC_MSG_RESULT(no); 53 | AC_MSG_ERROR(at least version 5.10.1 is required to run mojolicious) 54 | else 55 | AC_MSG_RESULT(ok); 56 | fi 57 | else 58 | AC_MSG_ERROR(could not find perl) 59 | fi 60 | 61 | 62 | AC_PATH_PROG(SED, sed, no) 63 | AC_PATH_PROG(GREP, grep, no) 64 | AC_PATH_PROG(ECHO, echo, no) 65 | AC_PATH_PROG(LN, ln, no) 66 | AC_PATH_PROG(CP, cp, no) 67 | AC_PATH_PROG(RM, rm, no) 68 | AC_PATH_PROG(RMDIR, rmdir, no) 69 | AC_PATH_PROG(MKDIR, mkdir, no) 70 | AC_PATH_PROG(FIND, find, no) 71 | AC_PATH_PROG(SENDMAIL, sendmail, /path/to/sendmail, $PATH:/usr/sbin:/usr/lib) 72 | AC_PATH_PROGS(NROFF, [gnroff nroff]) 73 | 74 | AC_ARG_VAR(GMAKE, [Path to local GNU Make binary]) 75 | AC_PATH_PROGS(GMAKE, [gnumake gmake make]) 76 | 77 | AC_MSG_CHECKING([checking for gnu make availability]) 78 | if ( $GMAKE --version 2> /dev/null | $GREP GNU > /dev/null 2>&1 ); then 79 | AC_MSG_RESULT([$GMAKE is GNU make]) 80 | else 81 | AC_MSG_ERROR([GNU make not found. Try setting the GMAKE environment variable.]) 82 | fi 83 | 84 | AC_ARG_ENABLE(pkgonly, 85 | [AS_HELP_STRING([--enable-pkgonly],[Skip all checking])]) 86 | AC_SUBST(enable_pkgonly) 87 | 88 | # $prefix stores the value of the --prefix command line option, or 89 | # NONE if the option wasn't set. In the case that it wasn't set, make 90 | # it be the default, so that we can use it to expand directories now. 91 | 92 | actual_prefix=$prefix 93 | if test x$actual_prefix = xNONE; then 94 | actual_prefix=$ac_default_prefix 95 | fi 96 | 97 | HTDOCSDIR=${actual_prefix}/htdocs 98 | AC_ARG_WITH(htdocs-dir,AS_HELP_STRING([--with-htdocs-dir=DIR],[Where to install htdocs [PREFIX/htdocs]]), [HTDOCSDIR=$withval]) 99 | AC_SUBST(HTDOCSDIR) 100 | 101 | AC_ARG_VAR(PERL5LIB, [Colon separated list of perl library directories]) 102 | 103 | AC_SUBST(PERL5LIB) 104 | 105 | # Check the necessary Perl modules 106 | 107 | mod_ok=1 108 | if test "$enable_pkgonly" != yes; then 109 | AC_MSG_CHECKING([checking for RRDs perl module]) 110 | if ${PERL} -e 'use RRDs' 2>/dev/null ; then 111 | AC_MSG_RESULT([Ok]) 112 | else 113 | AC_MSG_RESULT([Failed]) 114 | mod_ok=0 115 | fi 116 | fi 117 | 118 | if test x$mod_ok = x0; then 119 | cat < $@ 58 | 59 | %.5: %.pod 60 | $(AM_V_GEN)$(POD2MAN) --section 5 > $@ 61 | 62 | Smokeping.3: ../lib/Smokeping.pm 63 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 64 | 65 | Smokeping_Examples.3: ../lib/Smokeping/Examples.pm 66 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 67 | 68 | Smokeping_RRDtools.3: ../lib/Smokeping/RRDtools.pm 69 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 70 | 71 | Smokeping_probes_%.pod: ../lib/Smokeping/probes/%.pm 72 | $(AM_V_GEN)$(MAKEPOD) Smokeping::probes::$* > $@ 73 | 74 | Smokeping_probes_%.3: Smokeping_probes_%.pod 75 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 76 | 77 | Smokeping_matchers_%.3: ../lib/Smokeping/matchers/%.pm 78 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 79 | 80 | Smokeping_sorters_%.3: ../lib/Smokeping/sorters/%.pm 81 | $(AM_V_GEN)$(POD2MAN) --section 3 > $@ 82 | 83 | smokeping.1: ../bin/smokeping 84 | $(AM_V_GEN)$(POD2MAN) --section 1 > $@ 85 | 86 | smokeping_cgi.1: ../bin/smokeping_cgi 87 | $(AM_V_GEN)$(POD2MAN) --section 1 > $@ 88 | 89 | tSmoke.1: ../bin/tSmoke 90 | $(AM_V_GEN)$(POD2MAN) --section 1 > $@ 91 | 92 | smokeinfo.1: ../bin/smokeinfo 93 | $(AM_V_GEN)$(POD2MAN) --section 1 > $@ 94 | 95 | smokeping_config.pod: ../lib/Smokeping.pm 96 | $(AM_V_GEN)$(MAKEPOD) > $@ 97 | 98 | smokeping_examples.pod: ../lib/Smokeping/Examples.pm ../etc/config.dist 99 | $(AM_V_GEN)$(MKDIR) -p examples 100 | $(AM_V_GEN)$(GENEX) 101 | 102 | .1.txt .3.txt .5.txt .7.txt: 103 | $(AM_V_GEN)GROFF_NO_SGR=1 @NROFF@ -man -Tlp $< > $@ 104 | 105 | 106 | CLEANFILES = *.[1357] smokeping_examples.pod smokeping_config.pod examples/* 107 | 108 | iman1dir = $(mandir)/man1 109 | iman1_DATA = $(MAN1) 110 | 111 | iman3dir = $(mandir)/man3 112 | iman3_DATA = $(MAN3) 113 | 114 | iman5dir = $(mandir)/man5 115 | iman5_DATA = $(MAN5) 116 | 117 | iman7dir = $(mandir)/man7 118 | iman7_DATA = $(MAN7) 119 | 120 | EXAMPLES := $(wildcard examples/config.*) 121 | 122 | etcdir = $(sysconfdir)/examples 123 | etc_DATA = $(EXAMPLES) 124 | 125 | -------------------------------------------------------------------------------- /doc/smokeping_install.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | smokeping_install - How to install SmokePing 4 | 5 | =head1 OVERVIEW 6 | 7 | This document explains how to setup SmokePing at your site. 8 | 9 | =head1 DESCRIPTION 10 | 11 | =head2 Prerequisites 12 | 13 | SmokePing does not stand alone. It relies on various other tools and 14 | services being present. Apart from a Unix OS and a working Perl installation 15 | you need the following components: 16 | 17 | =over 18 | 19 | =item RRDtool 1.2.x or later 20 | 21 | Smokeping uses RRDtool for logging and graphing. If your linux distro provides 22 | an rrdtool package with perl support, use this. If you want to get the latest 23 | and greatest version, compile your own: L 24 | 25 | Ubuntu: 26 | 27 | sudo apt install rrdtool librrds-perl libssl-dev 28 | 29 | RedHat: 30 | 31 | sudo yum install rrdtool perl-rrdtool openssl-devel 32 | 33 | =item FPing (optional) 34 | 35 | Go to L to grab a copy. 36 | 37 | Note that fping must be installed setuid root. It seems that older versions 38 | of fping report round trip times in 0.1 milliseconds instead of 1 milliseconds 39 | as advertised ... SmokePing tries to figure this out. It tells 40 | you when it starts ... let me know if it gets it wrong. 41 | 42 | =item EchoPing (Optional) 43 | 44 | L 45 | 46 | You need this to run the EchoPing probes 47 | 48 | =item Curl (Optional) 49 | 50 | L 51 | 52 | You need this for the Curl probe. 53 | 54 | =item dig (Optional) 55 | 56 | L 57 | 58 | You need this for the DNS probe. 59 | 60 | =item SSH (Optional) 61 | 62 | L 63 | 64 | You need this for the SSH probe. 65 | 66 | =item Webserver 67 | 68 | L 69 | 70 | Well I won't get much into this. The important thing is, to have a webserver 71 | which allows you to run CGI and preferably FastCGI scripts. If you are using 72 | Apache I strongly recommend using the F system for running CGI 73 | scripts as a particular user. 74 | 75 | See L and 76 | L for more information 77 | on this. 78 | 79 | =item Perl 5.10.1 or later. 80 | 81 | If you still have an older version, maybe have a look at perlbrew. 82 | 83 | Ubuntu: 84 | 85 | sudo apt install perl 86 | 87 | RedHat: 88 | 89 | sudo yum install perl-core 90 | 91 | =back 92 | 93 | =head2 Installation 94 | 95 | Once the tools listed above are in place, you can start setting up SmokePing 96 | itself. Unpack the tar archive and run the included configure script: 97 | 98 | ./configure --prefix=/opt/smokeping 99 | 100 | Configure will verify that all the required perl modules are available. 101 | If some are missing it will tell you to run the module build script. 102 | Just follow the instructions on screen and then run configure again. 103 | Once it completes, you can run 104 | 105 | make install 106 | 107 | to finish your setup. 108 | 109 | =head2 Configuration 110 | 111 | Use the F file as a template to create your own smokeping configuration file. 112 | See L for details. 113 | 114 | =over 115 | 116 | =item Installing the webinterface 117 | 118 | Copy the content of the F directory to the place where your webserver 119 | expects its data. Maybe to F. 120 | 121 | Edit the F script to point to your smokeping_cgi script. 122 | 123 | If you have no FastCGI support in your webserver, you may want to use the 124 | F script. 125 | 126 | =item F 127 | 128 | Edit the html template to your liking. Please do not remove the link to the 129 | SmokePing counter and my name from the template. The content of the 130 | template will be rendered by smokeping.cgi. This means that all embedded 131 | links must be relative to smokeping.cgi. 132 | If you are using HTTP authentication, then the template variable C will be populated 133 | from the C<$ENV{REMOTE_USER}> environment variable. 134 | 135 | =item F 136 | 137 | If you are going to use the B IP support, customize the contents of this file. 138 | 139 | =back 140 | 141 | =head2 Starting the Smokeping Daemon 142 | 143 | With all the scaffolding in place, you can now launch the smokeping daemon and 144 | have it gather data for you. First you may want to run it in debug mode to see what 145 | it is doing 146 | 147 | ./bin/smokeping --config=/opt/smokeping/etc/config --debug 148 | 149 | once all is well, start it up as a daemon. I would recommend you enable the 150 | logfile option so that you can see if it runs into trouble. 151 | 152 | ./bin/smokeping --config=/opt/smokeping/etc/config --logfile=smoke.log 153 | 154 | Once the system works, you may want to put a SmokePing startup script into 155 | your F tree. Check out L for further information. 156 | 157 | You can now open the smokeping.cgi webpage to look at your data. 158 | 159 | See the L documentation on how to setup the smokeping web interface. 160 | 161 | =head1 COPYRIGHT 162 | 163 | Copyright (c) 2001, 2011 by Tobias Oetiker. All right reserved. 164 | 165 | =head1 LICENSE 166 | 167 | This program is free software; you can redistribute it 168 | and/or modify it under the terms of the GNU General Public 169 | License as published by the Free Software Foundation; either 170 | version 2 of the License, or (at your option) any later 171 | version. 172 | 173 | This program is distributed in the hope that it will be 174 | useful, but WITHOUT ANY WARRANTY; without even the implied 175 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 176 | PURPOSE. See the GNU General Public License for more 177 | details. 178 | 179 | You should have received a copy of the GNU General Public 180 | License along with this program; if not, write to the Free 181 | Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 182 | 02139, USA. 183 | 184 | =head1 AUTHOR 185 | 186 | Tobias Oetiker Etobi@oetiker.chE 187 | 188 | =cut 189 | -------------------------------------------------------------------------------- /etc/Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2011 Tobias Oetiker 2 | # 3 | # This program is free software; you can redistribute it and/or modify 4 | # it under the terms of the GNU General Public License as published by 5 | # the Free Software Foundation; either version 2 of the License, or 6 | # (at your option) any later version. 7 | # 8 | # This program is distributed in the hope that it will be useful, 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 | # GNU General Public License for more details. 12 | # 13 | # You should have received a copy of the GNU General Public License 14 | # along with this program; if not, write to the Free Software 15 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 16 | 17 | 18 | EXTRA_DIST = basepage.html.dist config.dist smokemail.dist smokeping_secrets.dist tmail.dist 19 | 20 | etcdir = $(sysconfdir) 21 | etc_DATA = $(EXTRA_DIST) 22 | -------------------------------------------------------------------------------- /etc/basepage.html.dist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | SmokePing Latency Page for <##title##> 7 | 8 | 9 | 14 | 15 | 16 | 17 | 34 | 35 |
36 |
Toggle Menu
37 |
Auto Refresh
38 |
<##authuser##>
39 |
40 | 41 |
42 |

<##title##>

43 |

<##remark##>

44 | 45 |
46 | <##overview##> 47 |
48 | 49 |
50 | <##body##> 51 |
52 |
53 |
54 |
55 |

Running on <##smokeping##> by <##author##>

56 |

Maintained by <##owner##>

57 |
58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /etc/config.dist.in: -------------------------------------------------------------------------------- 1 | *** General *** 2 | 3 | owner = Peter Random 4 | contact = some@address.nowhere 5 | mailhost = my.mail.host 6 | sendmail = @SENDMAIL@ 7 | # NOTE: do not put the Image Cache below cgi-bin 8 | # since all files under cgi-bin will be executed ... this is not 9 | # good for images. 10 | imgcache = @prefix@/cache 11 | imgurl = cache 12 | datadir = @prefix@/data 13 | piddir = @prefix@/var 14 | cgiurl = http://some.url/smokeping.cgi 15 | smokemail = @prefix@/etc/smokemail.dist 16 | tmail = @prefix@/etc/tmail.dist 17 | # specify this to get syslog logging 18 | syslogfacility = local0 19 | # each probe is now run in its own process 20 | # disable this to revert to the old behaviour 21 | # concurrentprobes = no 22 | 23 | *** Alerts *** 24 | to = alertee@address.somewhere 25 | from = smokealert@company.xy 26 | 27 | +someloss 28 | type = loss 29 | # in percent 30 | pattern = >0%,*12*,>0%,*12*,>0% 31 | comment = loss 3 times in a row 32 | 33 | *** Database *** 34 | 35 | step = 300 36 | pings = 20 37 | 38 | # consfn mrhb steps total 39 | 40 | AVERAGE 0.5 1 28800 41 | AVERAGE 0.5 12 9600 42 | MIN 0.5 12 9600 43 | MAX 0.5 12 9600 44 | AVERAGE 0.5 144 2400 45 | MAX 0.5 144 2400 46 | MIN 0.5 144 2400 47 | 48 | *** Presentation *** 49 | 50 | template = @prefix@/etc/basepage.html.dist 51 | htmltitle = yes 52 | graphborders = no 53 | # If enabled, treat all filter menu queries as literal strings instead of regex 54 | literalsearch = no 55 | 56 | + charts 57 | 58 | menu = Charts 59 | title = The most interesting destinations 60 | 61 | ++ stddev 62 | sorter = StdDev(entries=>4) 63 | title = Top Standard Deviation 64 | menu = Std Deviation 65 | format = Standard Deviation %f 66 | 67 | ++ max 68 | sorter = Max(entries=>5) 69 | title = Top Max Roundtrip Time 70 | menu = by Max 71 | format = Max Roundtrip Time %f seconds 72 | 73 | ++ loss 74 | sorter = Loss(entries=>5) 75 | title = Top Packet Loss 76 | menu = Loss 77 | format = Packets Lost %f 78 | 79 | ++ median 80 | sorter = Median(entries=>5) 81 | title = Top Median Roundtrip Time 82 | menu = by Median 83 | format = Median RTT %f seconds 84 | 85 | + overview 86 | 87 | width = 600 88 | height = 50 89 | range = 10h 90 | 91 | + detail 92 | 93 | width = 600 94 | height = 200 95 | unison_tolerance = 2 96 | 97 | "Last 3 Hours" 3h 98 | "Last 30 Hours" 30h 99 | "Last 10 Days" 10d 100 | "Last 360 Days" 360d 101 | 102 | #+ hierarchies 103 | #++ owner 104 | #title = Host Owner 105 | #++ location 106 | #title = Location 107 | 108 | *** Probes *** 109 | 110 | + FPing 111 | 112 | binary = /usr/sbin/fping 113 | 114 | *** Slaves *** 115 | secrets=@prefix@/etc/smokeping_secrets.dist 116 | +boomer 117 | display_name=boomer 118 | color=0000ff 119 | 120 | +slave2 121 | display_name=another 122 | color=00ff00 123 | 124 | *** Targets *** 125 | 126 | probe = FPing 127 | 128 | menu = Top 129 | title = Network Latency Grapher 130 | remark = Welcome to the SmokePing website of xxx Company. \ 131 | Here you will learn all about the latency of our network. 132 | 133 | + Test 134 | menu= Targets 135 | #parents = owner:/Test/James location:/ 136 | 137 | ++ James 138 | 139 | menu = James 140 | title =James 141 | alerts = someloss 142 | slaves = boomer slave2 143 | host = james.address 144 | 145 | ++ MultiHost 146 | 147 | menu = Multihost 148 | title = James and James as seen from Boomer 149 | host = /Test/James /Test/James~boomer 150 | 151 | -------------------------------------------------------------------------------- /etc/smokemail.dist: -------------------------------------------------------------------------------- 1 | From: <##FROM##> 2 | To: <##TO##> 3 | Subject: SmokePing Agent 4 | 5 | Hi, 6 | 7 | Please execute the attached Perl Script on your computer. It will register 8 | your IP with SmokePing. You have to rerun this script at least every time 9 | your IP changes. You can run the script as often as you want. 10 | 11 | The script is written in Perl. If you don't have Perl available on your 12 | system, you must have a Windows Box. You can easily fix this problem by 13 | downloading ActivePerl from www.activestate.com 14 | 15 | As soon as you have run the SmokePing Agent, the SmokePing server will 16 | start monitoring your host. Check out: 17 | <##URL##>?target=<##PATH##> 18 | 19 | Cheers 20 | <##OWNER##> 21 | 22 | ------------8<------------------------ 23 | #!/usr/bin/perl -w 24 | 25 | my $url = '<##URL##>'; 26 | my $path = '<##PATH##>'; 27 | my $secret = '<##SECRET##>'; 28 | 29 | use strict; 30 | use IO::Socket; 31 | 32 | my $post="target=${path}&secret=${secret}"; 33 | my $clen=length $post; 34 | 35 | $url =~ m|http://([^/]+)(/.+)|; 36 | my $host = $1; 37 | my $script = $2; 38 | 39 | my $remote = IO::Socket::INET->new( Proto => "tcp", 40 | PeerAddr => $host, 41 | PeerPort => "http(80)", 42 | ); 43 | exit 0 unless $remote; 44 | $remote->autoflush(1); 45 | 46 | print $remote <<"REQUEST"; 47 | POST $script HTTP/1.0\r 48 | User-Agent: smokeping-agent/1.0\r 49 | Host: ${host}:80\r 50 | Pragma: no-cache\r 51 | Content-Length: ${clen}\r 52 | Content-Type: application/x-www-form-urlencoded\r 53 | \r 54 | ${post}\r 55 | REQUEST 56 | 57 | my $head = 1; 58 | while (<$remote>) { 59 | /^\s*$/ && do {$head=0;next}; 60 | print unless $head; 61 | } 62 | 63 | close $remote; 64 | exit; 65 | ------------8<------------------------ 66 | -------------------------------------------------------------------------------- /etc/smokeping_secrets.dist: -------------------------------------------------------------------------------- 1 | host1:mysecret 2 | host2:yoursecret 3 | boomer:lkasdf93uhhfdfddf 4 | -------------------------------------------------------------------------------- /etc/tmail.dist: -------------------------------------------------------------------------------- 1 | MIME-Version: 1.0 2 | Content-Type: text/html 3 | 4 | 5 | 6 | IT System Availability Report 7 | 86 | 87 | 92 | 93 | 95 |
94 | Put your logo hereXXXX IT System Availability
96 |

97 |

98 |

99 |

100 | <##SUMMARY##> 101 |

102 |

103 | 104 | 105 | 107 | 109 | 111 | 113 | 114 |
Quarterly DetailMonthly DetailWeekly DetailDaily Detail
115 |
116 |

117 |

118 | <##DAYDETAIL##> 119 |
120 |

121 |

122 | <##WEEKDETAIL##> 123 |
124 |

125 |

126 | <##MONTHDETAIL##> 127 |
128 |

129 |

130 | <##QUARTERDETAIL##> 131 |
132 | 133 | -------------------------------------------------------------------------------- /htdocs/Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2010 Stanislav Sinyagin 2 | # Copyright (C) 2011 Tobias Oetiker 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 17 | 18 | JS = js/smokeping.js \ 19 | js/prototype.js \ 20 | js/cropper/cropper.js \ 21 | js/cropper/licence.txt \ 22 | js/cropper/marqueeVert.gif \ 23 | js/cropper/cropper.uncompressed.js \ 24 | js/cropper/cropper.css \ 25 | js/cropper/marqueeHoriz.gif \ 26 | js/scriptaculous/controls.js \ 27 | js/scriptaculous/slider.js \ 28 | js/scriptaculous/sound.js \ 29 | js/scriptaculous/effects.js \ 30 | js/scriptaculous/unittest.js \ 31 | js/scriptaculous/builder.js \ 32 | js/scriptaculous/scriptaculous.js \ 33 | js/scriptaculous/dragdrop.js \ 34 | css/smokeping-print.css \ 35 | css/smokeping-screen.css 36 | 37 | EXTRA_DIST = $(JS) 38 | 39 | jsdir = $(HTDOCSDIR) 40 | nobase_js_DATA = $(JS) 41 | 42 | install-data-local: 43 | $(MKDIR) -p $(DESTDIR)$(HTDOCSDIR) 44 | $(ECHO) "#!/bin/sh" > $(DESTDIR)$(HTDOCSDIR)/smokeping.fcgi.dist 45 | $(ECHO) "exec $(bindir)/smokeping_cgi $(sysconfdir)/config" >> $(DESTDIR)$(HTDOCSDIR)/smokeping.fcgi.dist 46 | chmod +x $(DESTDIR)$(HTDOCSDIR)/smokeping.fcgi.dist 47 | -------------------------------------------------------------------------------- /htdocs/css/smokeping-print.css: -------------------------------------------------------------------------------- 1 | body, html { 2 | font-family: "Helvetica Neue",Helvetica,Arial,sans-serif; 3 | font-size: 12px; 4 | } 5 | img { 6 | border: 0; 7 | } 8 | .sidebar, .navbar { 9 | display: none; 10 | } 11 | .panel { 12 | page-break-inside: avoid; 13 | } 14 | .panel h2 { 15 | font-size: 12px; 16 | } 17 | -------------------------------------------------------------------------------- /htdocs/js/cropper/cropper.css: -------------------------------------------------------------------------------- 1 | .imgCrop_wrap { 2 | /* width: 500px; @done_in_js */ 3 | /* height: 375px; @done_in_js */ 4 | position: relative; 5 | cursor: crosshair; 6 | } 7 | 8 | /* an extra classname is applied for Opera < 9.0 to fix it's lack of opacity support */ 9 | .imgCrop_wrap.opera8 .imgCrop_overlay, 10 | .imgCrop_wrap.opera8 .imgCrop_clickArea { 11 | background-color: transparent; 12 | } 13 | 14 | /* fix for IE displaying all boxes at line-height by default, although they are still 1 pixel high until we combine them with the pointless span */ 15 | .imgCrop_wrap, 16 | .imgCrop_wrap * { 17 | font-size: 0; 18 | line-height: 0; 19 | opacity: 1; 20 | filter:alpha(opacity=100); 21 | } 22 | 23 | .imgCrop_overlay { 24 | background-color: #000; 25 | opacity: 0.5; 26 | filter:alpha(opacity=50); 27 | position: absolute; 28 | width: 100%; 29 | height: 100%; 30 | } 31 | 32 | .imgCrop_selArea { 33 | position: absolute; 34 | /* @done_in_js 35 | top: 20px; 36 | left: 20px; 37 | width: 200px; 38 | height: 200px; 39 | background: transparent url(castle.jpg) no-repeat -210px -110px; 40 | */ 41 | cursor: move; 42 | z-index: 2; 43 | } 44 | 45 | /* clickArea is all a fix for IE 5.5 & 6 to allow the user to click on the given area */ 46 | .imgCrop_clickArea { 47 | width: 100%; 48 | height: 100%; 49 | background-color: #FFF; 50 | opacity: 0.01; 51 | filter:alpha(opacity=01); 52 | } 53 | 54 | .imgCrop_marqueeHoriz { 55 | position: absolute; 56 | width: 100%; 57 | height: 1px; 58 | background: transparent url(marqueeHoriz.gif) repeat-x 0 0; 59 | z-index: 3; 60 | } 61 | 62 | .imgCrop_marqueeVert { 63 | position: absolute; 64 | height: 100%; 65 | width: 1px; 66 | background: transparent url(marqueeVert.gif) repeat-y 0 0; 67 | z-index: 3; 68 | } 69 | 70 | /* 71 | * FIX MARCHING ANTS IN IE 72 | * As IE <6 tries to load background images we can uncomment the follwoing hack 73 | * to remove that issue, not as pretty - but is anything in IE? 74 | * And yes I do know that 'filter' is evil, but it will make it look semi decent in IE 75 | * 76 | * html .imgCrop_marqueeHoriz, 77 | * html .imgCrop_marqueeVert { 78 | background: transparent; 79 | filter: Invert; 80 | } 81 | * html .imgCrop_marqueeNorth { border-top: 1px dashed #000; } 82 | * html .imgCrop_marqueeEast { border-right: 1px dashed #000; } 83 | * html .imgCrop_marqueeSouth { border-bottom: 1px dashed #000; } 84 | * html .imgCrop_marqueeWest { border-left: 1px dashed #000; } 85 | */ 86 | 87 | .imgCrop_marqueeNorth { top: 0; left: 0; } 88 | .imgCrop_marqueeEast { top: 0; right: 0; } 89 | .imgCrop_marqueeSouth { bottom: 0px; left: 0; } 90 | .imgCrop_marqueeWest { top: 0; left: 0; } 91 | 92 | 93 | .imgCrop_handle { 94 | position: absolute; 95 | border: 1px solid #333; 96 | width: 6px; 97 | height: 6px; 98 | background: #FFF; 99 | opacity: 0.5; 100 | filter:alpha(opacity=50); 101 | z-index: 4; 102 | } 103 | 104 | /* fix IE 5 box model */ 105 | * html .imgCrop_handle { 106 | width: 8px; 107 | height: 8px; 108 | wid\th: 6px; 109 | hei\ght: 6px; 110 | } 111 | 112 | .imgCrop_handleN { 113 | top: -3px; 114 | left: 0; 115 | /* margin-left: 49%; @done_in_js */ 116 | cursor: n-resize; 117 | } 118 | 119 | .imgCrop_handleNE { 120 | top: -3px; 121 | right: -3px; 122 | cursor: ne-resize; 123 | } 124 | 125 | .imgCrop_handleE { 126 | top: 0; 127 | right: -3px; 128 | /* margin-top: 49%; @done_in_js */ 129 | cursor: e-resize; 130 | } 131 | 132 | .imgCrop_handleSE { 133 | right: -3px; 134 | bottom: -3px; 135 | cursor: se-resize; 136 | } 137 | 138 | .imgCrop_handleS { 139 | right: 0; 140 | bottom: -3px; 141 | /* margin-right: 49%; @done_in_js */ 142 | cursor: s-resize; 143 | } 144 | 145 | .imgCrop_handleSW { 146 | left: -3px; 147 | bottom: -3px; 148 | cursor: sw-resize; 149 | } 150 | 151 | .imgCrop_handleW { 152 | top: 0; 153 | left: -3px; 154 | /* margin-top: 49%; @done_in_js */ 155 | cursor: w-resize; 156 | } 157 | 158 | .imgCrop_handleNW { 159 | top: -3px; 160 | left: -3px; 161 | cursor: nw-resize; 162 | } 163 | 164 | /** 165 | * Create an area to click & drag around on as the default browser behaviour is to let you drag the image 166 | */ 167 | .imgCrop_dragArea { 168 | width: 100%; 169 | height: 100%; 170 | z-index: 200; 171 | position: absolute; 172 | top: 0; 173 | left: 0; 174 | } 175 | 176 | .imgCrop_previewWrap { 177 | /* width: 200px; @done_in_js */ 178 | /* height: 200px; @done_in_js */ 179 | overflow: hidden; 180 | position: relative; 181 | } 182 | 183 | .imgCrop_previewWrap img { 184 | position: absolute; 185 | } -------------------------------------------------------------------------------- /htdocs/js/cropper/licence.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2006-2011, David Spurr (www.defusion.org.uk) 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 7 | * Neither the name of the David Spurr nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 8 | 9 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 10 | 11 | http://www.opensource.org/licenses/bsd-license.php -------------------------------------------------------------------------------- /htdocs/js/cropper/marqueeHoriz.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/oetiker/SmokePing/92db127e5a540e4f75b2255f941e8c2a5ed681b0/htdocs/js/cropper/marqueeHoriz.gif -------------------------------------------------------------------------------- /htdocs/js/cropper/marqueeVert.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/oetiker/SmokePing/92db127e5a540e4f75b2255f941e8c2a5ed681b0/htdocs/js/cropper/marqueeVert.gif -------------------------------------------------------------------------------- /htdocs/js/scriptaculous/builder.js: -------------------------------------------------------------------------------- 1 | var Builder={NODEMAP:{AREA:"map",CAPTION:"table",COL:"table",COLGROUP:"table",LEGEND:"fieldset",OPTGROUP:"select",OPTION:"select",PARAM:"object",TBODY:"table",TD:"table",TFOOT:"table",TH:"table",THEAD:"table",TR:"table"},node:function(e){e=e.toUpperCase();var t=this.NODEMAP[e]||"div",i=document.createElement(t);try{i.innerHTML="<"+e+">"}catch(n){}var r=i.firstChild||null;if(r&&r.tagName.toUpperCase()!=e&&(r=r.getElementsByTagName(e)[0]),r||(r=document.createElement(e)),r){if(arguments[1])if(this._isStringOrNumber(arguments[1])||arguments[1]instanceof Array||arguments[1].tagName)this._children(r,arguments[1]);else{var s=this._attributes(arguments[1]);if(s.length){try{i.innerHTML="<"+e+" "+s+">"}catch(n){}if(r=i.firstChild||null,!r){r=document.createElement(e);for(attr in arguments[1])r["class"==attr?"className":attr]=arguments[1][attr]}r.tagName.toUpperCase()!=e&&(r=i.getElementsByTagName(e)[0])}}return arguments[2]&&this._children(r,arguments[2]),$(r)}},_text:function(e){return document.createTextNode(e)},ATTR_MAP:{className:"class",htmlFor:"for"},_attributes:function(e){var t=[];for(attribute in e)t.push((attribute in this.ATTR_MAP?this.ATTR_MAP[attribute]:attribute)+'="'+(""+e[attribute]).escapeHTML().gsub(/"/,""")+'"');return t.join(" ")},_children:function(e,t){return t.tagName?(e.appendChild(t),void 0):("object"==typeof t?t.flatten().each(function(t){"object"==typeof t?e.appendChild(t):Builder._isStringOrNumber(t)&&e.appendChild(Builder._text(t))}):Builder._isStringOrNumber(t)&&e.appendChild(Builder._text(t)),void 0)},_isStringOrNumber:function(e){return"string"==typeof e||"number"==typeof e},build:function(e){var t=this.node("div");return $(t).update(e.strip()),t.down()},dump:function(e){"object"!=typeof e&&"function"!=typeof e&&(e=window);var t="A ABBR ACRONYM ADDRESS APPLET AREA B BASE BASEFONT BDO BIG BLOCKQUOTE BODY BR BUTTON CAPTION CENTER CITE CODE COL COLGROUP DD DEL DFN DIR DIV DL DT EM FIELDSET FONT FORM FRAME FRAMESET H1 H2 H3 H4 H5 H6 HEAD HR HTML I IFRAME IMG INPUT INS ISINDEX KBD LABEL LEGEND LI LINK MAP MENU META NOFRAMES NOSCRIPT OBJECT OL OPTGROUP OPTION P PARAM PRE Q S SAMP SCRIPT SELECT SMALL SPAN STRIKE STRONG STYLE SUB SUP TABLE TBODY TD TEXTAREA TFOOT TH THEAD TITLE TR TT U UL VAR".split(/\s+/);t.each(function(t){e[t]=function(){return Builder.node.apply(Builder,[t].concat($A(arguments)))}})}}; -------------------------------------------------------------------------------- /htdocs/js/scriptaculous/scriptaculous.js: -------------------------------------------------------------------------------- 1 | var Scriptaculous={Version:"1.9.0",require:function(e){try{document.write('')}catch(t){var i=document.createElement("script");i.type="text/javascript",i.src=e,document.getElementsByTagName("head")[0].appendChild(i)}},REQUIRED_PROTOTYPE:"1.6.0.3",load:function(){function e(e){var t=e.replace(/_.*|\./g,"");return t=parseInt(t+"0".times(4-t.length)),e.indexOf("_")>-1?t-1:t}if("undefined"==typeof Prototype||"undefined"==typeof Element||Element.Methods===void 0||e(Prototype.Version)= "+Scriptaculous.REQUIRED_PROTOTYPE;var t=/scriptaculous\.js(\?.*)?$/;$$("script[src]").findAll(function(e){return e.src.match(t)}).each(function(e){var i=e.src.replace(t,""),n=e.src.match(/\?.*load=([a-z,]*)/);(n?n[1]:"builder,effects,dragdrop,controls,slider,sound").split(",").each(function(e){Scriptaculous.require(i+e+".js")})})}};Scriptaculous.load(); -------------------------------------------------------------------------------- /htdocs/js/scriptaculous/slider.js: -------------------------------------------------------------------------------- 1 | if(!Control)var Control={};Control.Slider=Class.create({initialize:function(e,t,i){var n=this;this.handles=Object.isArray(e)?e.collect(function(e){return $(e)}):[$(e)],this.track=$(t),this.options=i||{},this.axis=this.options.axis||"horizontal",this.increment=this.options.increment||1,this.step=parseInt(this.options.step||"1"),this.range=this.options.range||$R(0,1),this.value=0,this.values=this.handles.map(function(){return 0}),this.spans=this.options.spans?this.options.spans.map(function(e){return $(e)}):!1,this.options.startSpan=$(this.options.startSpan||null),this.options.endSpan=$(this.options.endSpan||null),this.restricted=this.options.restricted||!1,this.maximum=this.options.maximum||this.range.end,this.minimum=this.options.minimum||this.range.start,this.alignX=parseInt(this.options.alignX||"0"),this.alignY=parseInt(this.options.alignY||"0"),this.trackLength=this.maximumOffset()-this.minimumOffset(),this.handleLength=this.isVertical()?0!=this.handles[0].offsetHeight?this.handles[0].offsetHeight:this.handles[0].style.height.replace(/px$/,""):0!=this.handles[0].offsetWidth?this.handles[0].offsetWidth:this.handles[0].style.width.replace(/px$/,""),this.active=!1,this.dragging=!1,this.disabled=!1,this.options.disabled&&this.setDisabled(),this.allowedValues=this.options.values?this.options.values.sortBy(Prototype.K):!1,this.allowedValues&&(this.minimum=this.allowedValues.min(),this.maximum=this.allowedValues.max()),this.eventMouseDown=this.startDrag.bindAsEventListener(this),this.eventMouseUp=this.endDrag.bindAsEventListener(this),this.eventMouseMove=this.update.bindAsEventListener(this),this.handles.each(function(e,t){t=n.handles.length-1-t,n.setValue(parseFloat((Object.isArray(n.options.sliderValue)?n.options.sliderValue[t]:n.options.sliderValue)||n.range.start),t),e.makePositioned().observe("mousedown",n.eventMouseDown)}),this.track.observe("mousedown",this.eventMouseDown),document.observe("mouseup",this.eventMouseUp),document.observe("mousemove",this.eventMouseMove),this.initialized=!0},dispose:function(){var e=this;Event.stopObserving(this.track,"mousedown",this.eventMouseDown),Event.stopObserving(document,"mouseup",this.eventMouseUp),Event.stopObserving(document,"mousemove",this.eventMouseMove),this.handles.each(function(t){Event.stopObserving(t,"mousedown",e.eventMouseDown)})},setDisabled:function(){this.disabled=!0},setEnabled:function(){this.disabled=!1},getNearestValue:function(e){if(this.allowedValues){if(e>=this.allowedValues.max())return this.allowedValues.max();if(this.allowedValues.min()>=e)return this.allowedValues.min();var t=Math.abs(this.allowedValues[0]-e),i=this.allowedValues[0];return this.allowedValues.each(function(n){var r=Math.abs(n-e);t>=r&&(i=n,t=r)}),i}return e>this.range.end?this.range.end:this.range.start>e?this.range.start:e},setValue:function(e,t){this.active||(this.activeHandleIdx=t||0,this.activeHandle=this.handles[this.activeHandleIdx],this.updateStyles()),t=t||this.activeHandleIdx||0,this.initialized&&this.restricted&&(t>0&&this.values[t-1]>e&&(e=this.values[t-1]),this.handles.length-1>t&&e>this.values[t+1]&&(e=this.values[t+1])),e=this.getNearestValue(e),this.values[t]=e,this.value=this.values[0],this.handles[t].style[this.isVertical()?"top":"left"]=this.translateToPx(e),this.drawSpans(),this.dragging&&this.event||this.updateFinished()},setValueBy:function(e,t){this.setValue(this.values[t||this.activeHandleIdx||0]+e,t||this.activeHandleIdx||0)},translateToPx:function(e){return Math.round((this.trackLength-this.handleLength)/(this.range.end-this.range.start)*(e-this.range.start))+"px"},translateToValue:function(e){return e/(this.trackLength-this.handleLength)*(this.range.end-this.range.start)+this.range.start},getRange:function(e){var t=this.values.sortBy(Prototype.K);return e=e||0,$R(t[e],t[e+1])},minimumOffset:function(){return this.isVertical()?this.alignY:this.alignX},maximumOffset:function(){return this.isVertical()?(0!=this.track.offsetHeight?this.track.offsetHeight:this.track.style.height.replace(/px$/,""))-this.alignY:(0!=this.track.offsetWidth?this.track.offsetWidth:this.track.style.width.replace(/px$/,""))-this.alignX},isVertical:function(){return"vertical"==this.axis},drawSpans:function(){var e=this;this.spans&&$R(0,this.spans.length-1).each(function(t){e.setSpan(e.spans[t],e.getRange(t))}),this.options.startSpan&&this.setSpan(this.options.startSpan,$R(0,this.values.length>1?this.getRange(0).min():this.value)),this.options.endSpan&&this.setSpan(this.options.endSpan,$R(this.values.length>1?this.getRange(this.spans.length-1).max():this.value,this.maximum))},setSpan:function(e,t){this.isVertical()?(e.style.top=this.translateToPx(t.start),e.style.height=this.translateToPx(t.end-t.start+this.range.start)):(e.style.left=this.translateToPx(t.start),e.style.width=this.translateToPx(t.end-t.start+this.range.start))},updateStyles:function(){this.handles.each(function(e){Element.removeClassName(e,"selected")}),Element.addClassName(this.activeHandle,"selected")},startDrag:function(e){if(Event.isLeftClick(e)){if(!this.disabled){this.active=!0;var t=Event.element(e),i=[Event.pointerX(e),Event.pointerY(e)],n=t;if(n==this.track){var r=this.track.cumulativeOffset();this.event=e,this.setValue(this.translateToValue((this.isVertical()?i[1]-r[1]:i[0]-r[0])-this.handleLength/2));var r=this.activeHandle.cumulativeOffset();this.offsetX=i[0]-r[0],this.offsetY=i[1]-r[1]}else{for(;-1==this.handles.indexOf(t)&&t.parentNode;)t=t.parentNode;if(-1!=this.handles.indexOf(t)){this.activeHandle=t,this.activeHandleIdx=this.handles.indexOf(this.activeHandle),this.updateStyles();var r=this.activeHandle.cumulativeOffset();this.offsetX=i[0]-r[0],this.offsetY=i[1]-r[1]}}}Event.stop(e)}},update:function(e){this.active&&(this.dragging||(this.dragging=!0),this.draw(e),Prototype.Browser.WebKit&&window.scrollBy(0,0),Event.stop(e))},draw:function(e){var t=[Event.pointerX(e),Event.pointerY(e)],i=this.track.cumulativeOffset();t[0]-=this.offsetX+i[0],t[1]-=this.offsetY+i[1],this.event=e,this.setValue(this.translateToValue(this.isVertical()?t[1]:t[0])),this.initialized&&this.options.onSlide&&this.options.onSlide(this.values.length>1?this.values:this.value,this)},endDrag:function(e){this.active&&this.dragging&&(this.finishDrag(e,!0),Event.stop(e)),this.active=!1,this.dragging=!1},finishDrag:function(){this.active=!1,this.dragging=!1,this.updateFinished()},updateFinished:function(){this.initialized&&this.options.onChange&&this.options.onChange(this.values.length>1?this.values:this.value,this),this.event=null}}); -------------------------------------------------------------------------------- /htdocs/js/scriptaculous/sound.js: -------------------------------------------------------------------------------- 1 | Sound={tracks:{},_enabled:!0,template:new Template(''),enable:function(){Sound._enabled=!0},disable:function(){Sound._enabled=!1},play:function(e){if(Sound._enabled){var t=Object.extend({track:"global",url:e,replace:!1},arguments[1]||{});t.replace&&this.tracks[t.track]&&($R(0,this.tracks[t.track].id).each(function(e){var i=$("sound_"+t.track+"_"+e);i.Stop&&i.Stop(),i.remove()}),this.tracks[t.track]=null),this.tracks[t.track]?this.tracks[t.track].id++:this.tracks[t.track]={id:0},t.id=this.tracks[t.track].id,$$("body")[0].insert(Prototype.Browser.IE?new Element("bgsound",{id:"sound_"+t.track+"_"+t.id,src:t.url,loop:1,autostart:!0}):Sound.template.evaluate(t))}}},Prototype.Browser.Gecko&&navigator.userAgent.indexOf("Win")>0&&(navigator.plugins&&$A(navigator.plugins).detect(function(e){return-1!=e.name.indexOf("QuickTime")})?Sound.template=new Template(''):navigator.plugins&&$A(navigator.plugins).detect(function(e){return-1!=e.name.indexOf("Windows Media")})?Sound.template=new Template(''):navigator.plugins&&$A(navigator.plugins).detect(function(e){return-1!=e.name.indexOf("RealPlayer")})?Sound.template=new Template(''):Sound.play=function(){}); -------------------------------------------------------------------------------- /htdocs/js/smokeping.js: -------------------------------------------------------------------------------- 1 | /*++ from bonsai.js ++ urlObj +++++++++++++++++++++++++++++++++++++++++*/ 2 | function urlObj(url) { 3 | var urlBaseAndParameters; 4 | 5 | urlBaseAndParameters = url.split("?"); 6 | this.urlBase = urlBaseAndParameters[0]; 7 | this.urlParameters = urlBaseAndParameters[1].split(/[;&]/); 8 | 9 | this.getUrlBase = urlObjGetUrlBase; 10 | } 11 | 12 | /*++ from bonsai.js ++ urlObjGetUrlBase +++++++++++++++++++++++++++++++*/ 13 | 14 | function urlObjGetUrlBase() { 15 | return this.urlBase; 16 | } 17 | 18 | function parseRelativeTime(currTime) { 19 | var unit = ''; 20 | var offset = 0; 21 | var sign = -1; 22 | var table = { 23 | s : 1, // 1 24 | m : 60, // s * 60 25 | h : 3600, // m * 60 26 | d : 86400, // h * 24 27 | w : 604800, // d * 7 28 | mo : 2592000, // d * 30 29 | y : 31536000, // d * 365 30 | }; 31 | var regexStr = currTime.match(/[+\-]|[^a-z]+|[a-zA-Z]+/gi); 32 | if (regexStr[0] == '+') 33 | sign = 1; 34 | for (i=1; i< regexStr.length; i=i+2) { 35 | unit = regexStr[i+1].slice(0,1); 36 | if (regexStr[i+1].slice(0,2) == 'mo' || (regexStr[i+1] == 'm' && Math.abs(regexStr[i]) <= 5)) 37 | unit = 'mo'; 38 | offset += regexStr[i]*table[unit]; 39 | 40 | } 41 | offset = offset*sign; 42 | return Math.floor(Date.now()/1000) + offset; 43 | } 44 | 45 | // example with minimum dimensions 46 | var myCropper; 47 | 48 | var StartEpoch = 0; 49 | var EndEpoch = 0; 50 | 51 | 52 | 53 | function changeRRDImage(coords,dimensions){ 54 | 55 | // disable reloading the RRD image while zoomed in 56 | try { 57 | window.stop(); 58 | } catch (exception) { 59 | // fallback for IE 60 | document.execCommand('Stop'); 61 | } 62 | 63 | var SelectLeft = Math.min(coords.x1,coords.x2); 64 | 65 | var SelectRight = Math.max(coords.x1,coords.x2); 66 | 67 | if (SelectLeft == SelectRight) 68 | return; // abort if nothing is selected. 69 | 70 | var RRDLeft = 67; // difference between left border of RRD image and content 71 | var RRDRight = 26; // difference between right border of RRD image and content 72 | var RRDImgWidth = $('zoom').getDimensions().width; // Width of the Smokeping RRD Graphik 73 | var RRDImgUsable = RRDImgWidth - RRDRight - RRDLeft; 74 | var form = $('range_form'); 75 | 76 | if (StartEpoch == 0) { 77 | StartEpoch = +$F('epoch_start'); 78 | if (isNaN(StartEpoch)) 79 | StartEpoch = parseRelativeTime($F('epoch_start')); 80 | } 81 | if (EndEpoch == 0) { 82 | EndEpoch = +$F('epoch_end'); 83 | if (isNaN(EndEpoch)) 84 | EndEpoch = parseRelativeTime($F('epoch_end')); 85 | } 86 | var DivEpoch = EndEpoch - StartEpoch; 87 | 88 | var Target = $F('target'); 89 | var Hierarchy = $F('hierarchy'); 90 | 91 | // construct Image URL 92 | var myURLObj = new urlObj(document.URL); 93 | 94 | var myURL = myURLObj.getUrlBase(); 95 | 96 | // Generate Selected Range in Unix Timestamps 97 | var LeftFactor = 1; 98 | var RightFactor = 1; 99 | 100 | if (SelectLeft < RRDLeft) 101 | LeftFactor = 10; 102 | 103 | StartEpoch = Math.floor(StartEpoch + (SelectLeft - RRDLeft) * DivEpoch / RRDImgUsable * LeftFactor ); 104 | 105 | if (SelectRight > RRDImgWidth - RRDRight) 106 | RightFactor = 10; 107 | 108 | EndEpoch = Math.ceil(EndEpoch + (SelectRight - (RRDImgWidth - RRDRight) ) * DivEpoch / RRDImgUsable * RightFactor); 109 | 110 | 111 | $('zoom').src = myURL + '?displaymode=a;start=' + StartEpoch + ';end=' + EndEpoch + ';target=' + Target + ';hierarchy=' + Hierarchy; 112 | 113 | myCropper.setParams(); 114 | 115 | }; 116 | 117 | if($('range_form') != null && $('range_form').length){ 118 | $('range_form').on('submit', (function() { 119 | $form = $(this); 120 | var cgiurl = $form.action.split("?"); 121 | var action = $form.serialize().split("&"); 122 | action = action.map(i=> i + ';'); 123 | $form.action = cgiurl[0] + "?" + action[4] + action[5] + action[6] + action[3]; 124 | })); 125 | } 126 | 127 | Event.observe( 128 | window, 129 | 'load', 130 | function() { 131 | let refresh = setTimeout(function () { 132 | location.reload(); 133 | }, window.options.step * 1000); 134 | 135 | $('menu-button').observe('click', function (e) { 136 | if ($('sidebar').getStyle('left') == '0px') { 137 | $('body').addClassName('sidebar-hidden'); 138 | $('body').removeClassName('sidebar-visible'); 139 | } else { 140 | $('body').removeClassName('sidebar-hidden'); 141 | $('body').addClassName('sidebar-visible'); 142 | } 143 | Event.stop(e); 144 | }); 145 | $('refresh-button').observe('click', function (e) { 146 | if (localStorage.getItem("noRefresh")) { 147 | localStorage.removeItem("noRefresh"); 148 | refresh = setTimeout(function () { 149 | location.reload(); 150 | }, window.options.step * 1000); 151 | $('refresh-button').style.textDecoration = "line-through"; 152 | } else { 153 | clearTimeout(refresh); 154 | localStorage.setItem("noRefresh", true); 155 | $('refresh-button').style.textDecoration = "none"; 156 | } 157 | Event.stop(e); 158 | }); 159 | if ($('zoom') != null) { 160 | myCropper = new Cropper.Img( 161 | 'zoom', 162 | { 163 | minHeight: $('zoom').getDimensions().height, 164 | maxHeight: $('zoom').getDimensions().height, 165 | onEndCrop: changeRRDImage 166 | } 167 | ) 168 | } 169 | } 170 | ); 171 | 172 | -------------------------------------------------------------------------------- /htdocs/smokeping.fcgi.dist: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | exec /opt/smokeping/bin/smokeping_cgi /opt/smokeping/etc/config 3 | -------------------------------------------------------------------------------- /lib/Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2010 Stanislav Sinyagin 2 | # Copyright (C) 2011 Tobias Oetiker 3 | # 4 | # This program is free software; you can redistribute it and/or modify 5 | # it under the terms of the GNU General Public License as published by 6 | # the Free Software Foundation; either version 2 of the License, or 7 | # (at your option) any later version. 8 | # 9 | # This program is distributed in the hope that it will be useful, 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | # GNU General Public License for more details. 13 | # 14 | # You should have received a copy of the GNU General Public License 15 | # along with this program; if not, write to the Free Software 16 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 17 | 18 | # 19 | AUTOMAKE_OPTIONS = foreign 20 | 21 | 22 | PM := $(wildcard *.pm) 23 | 24 | SP := $(wildcard Smokeping/*.pm) 25 | 26 | SORT := $(wildcard Smokeping/sorters/*.pm) 27 | 28 | PROBE := $(wildcard Smokeping/probes/*.pm) 29 | 30 | MATCH := $(wildcard Smokeping/matchers/*.pm) 31 | 32 | EXTRA_DIST = $(PM) $(SP) $(SORT) $(PROBE) $(MATCH) 33 | 34 | perllibdir = $(prefix)/lib 35 | nobase_perllib_DATA = $(EXTRA_DIST) 36 | -------------------------------------------------------------------------------- /lib/Smokeping/Colorspace.pm: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | 3 | package Smokeping::Colorspace; 4 | 5 | =head1 NAME 6 | 7 | Smokeping::Colorspace - Simple Colorspace Conversion methods 8 | 9 | =head1 OVERVIEW 10 | 11 | This module provides simple colorspace conversion methods, primarily allowing 12 | conversion from RGB (red, green, blue) to and from HSL (hue, saturation, luminosity). 13 | 14 | =head1 COPYRIGHT 15 | 16 | Copyright 2006 by Grahame Bowland. 17 | 18 | =head1 LICENSE 19 | 20 | This program is free software; you can redistribute it 21 | and/or modify it under the terms of the GNU General Public 22 | License as published by the Free Software Foundation; either 23 | version 2 of the License, or (at your option) any later 24 | version. 25 | 26 | This program is distributed in the hope that it will be 27 | useful, but WITHOUT ANY WARRANTY; without even the implied 28 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 29 | PURPOSE. See the GNU General Public License for more 30 | details. 31 | 32 | You should have received a copy of the GNU General Public 33 | License along with this program; if not, write to the Free 34 | Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 35 | 02139, USA. 36 | 37 | =head1 AUTHOR 38 | 39 | Grahame Bowland 40 | 41 | =cut 42 | 43 | sub web_to_rgb { 44 | my $web = shift; 45 | $web =~ s/^#//; 46 | my @rgb = (hex(substr($web, 0, 2)) / 255, 47 | hex(substr($web, 2, 2)) / 255, 48 | hex(substr($web, 4, 2)) / 255) ; 49 | return @rgb; 50 | } 51 | 52 | sub rgb_to_web { 53 | my @rgb = @_; 54 | return sprintf("#%.2x%.2x%.2x", 255 * $rgb[0], 255 * $rgb[1], 255 * $rgb[2]); 55 | } 56 | 57 | sub min_max_indexes { 58 | my $idx = 0; 59 | my ($min_idx, $min, $max_idx, $max); 60 | my @l = @_; 61 | 62 | foreach my $i (@l) { 63 | if (not defined($min) or ($i < $min)) { 64 | $min = $i; 65 | $min_idx = $idx; 66 | } 67 | if (not defined($max) or ($i > $max)) { 68 | $max = $i; 69 | $max_idx = $idx; 70 | } 71 | $idx++; 72 | } 73 | return ($min_idx, $min, $max_idx, $max); 74 | } 75 | 76 | # source for conversion algorithm is: 77 | # http://www.easyrgb.com/math.php?MATH=M18#text18 78 | sub rgb_to_hsl { 79 | my @rgb = @_; 80 | my ($h, $l, $s); 81 | 82 | my ($min_idx, $min, $max_idx, $max) = min_max_indexes(@rgb); 83 | my $delta_max = $max - $min; 84 | $l = ($max + $min) / 2; 85 | if ($delta_max == 0) { 86 | my $h = 0; 87 | my $s = 0; 88 | } else { 89 | if ($l < 0.5) { 90 | $s = $delta_max / ($max + $min); 91 | } else { 92 | $s = $delta_max / (2 - $max - $min); 93 | } 94 | my $delta_r = ((($max - $rgb[0]) / 6) + ($max / 2)) / $delta_max; 95 | my $delta_g = ((($max - $rgb[1]) / 6) + ($max / 2)) / $delta_max; 96 | my $delta_b = ((($max - $rgb[2]) / 6) + ($max / 2)) / $delta_max; 97 | if ($max_idx == 0) { 98 | $h = $delta_b - $delta_g; 99 | } elsif ($max_idx == 1) { 100 | $h = (1/3) + $delta_r - $delta_b; 101 | } else { 102 | $h = (2/3) + $delta_g - $delta_r; 103 | } 104 | if ($h < 0) { 105 | $h += 1; 106 | } elsif ($h > 1) { 107 | $h -= 1; 108 | } 109 | } 110 | return ($h, $s, $l); 111 | } 112 | 113 | sub hue_to_rgb { 114 | my ($v1, $v2, $vh) = @_; 115 | if ($vh < 0) { 116 | $vh += 1; 117 | } elsif ($vh > 1) { 118 | $vh -= 1; 119 | } 120 | if ($vh * 6 < 1) { 121 | return $v1 + ($v2 - $v1) * 6 * $vh; 122 | } elsif ($vh * 2 < 1) { 123 | return $v2; 124 | } elsif ($vh * 3 < 2) { 125 | return $v1 + ($v2 - $v1) * ((2/3) - $vh) * 6; 126 | } else { 127 | return $v1; 128 | } 129 | } 130 | 131 | sub hsl_to_rgb { 132 | my ($h, $s, $l) = @_; 133 | my ($r, $g, $b); 134 | if ($s == 0) { 135 | $r = $g = $b = $l; 136 | } else { 137 | my $ls; 138 | if ($l < 0.5) { 139 | $ls = $l * (1 + $s); 140 | } else { 141 | $ls = ($l + $s) - ($s * $l); 142 | } 143 | $l = 2 * $l - $ls; 144 | $r = hue_to_rgb($l, $ls, $h + 1/3); 145 | $g = hue_to_rgb($l, $ls, $h); 146 | $b = hue_to_rgb($l, $ls, $h - (1/3)); 147 | } 148 | return ($r, $g, $b); 149 | } 150 | 151 | 1; 152 | 153 | -------------------------------------------------------------------------------- /lib/Smokeping/Config.pm: -------------------------------------------------------------------------------- 1 | # provide backward compatibility for Config::Grammar 2 | package Smokeping::Config; 3 | 4 | BEGIN { 5 | require Config::Grammar; 6 | if($Config::Grammar::VERSION ge '1.10') { 7 | require Config::Grammar::Dynamic; 8 | @ISA = qw(Config::Grammar::Dynamic); 9 | } 10 | else { 11 | @ISA = qw(Config::Grammar); 12 | } 13 | } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/Smokeping/RRDhelpers.pm: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | package Smokeping::RRDhelpers; 3 | 4 | =head1 NAME 5 | 6 | Smokeping::RRDhelpers - Functions for doing 'interesting things' with RRDs. 7 | 8 | =head1 OVERVIEW 9 | 10 | This module holds a collection of functions for doing advanced calculations 11 | and effects on rrd files. 12 | 13 | =cut 14 | 15 | use strict; 16 | use RRDs; 17 | 18 | =head2 IMPLEMENTATION 19 | 20 | =head3 get_stddev(rrd,ds,cf,start,end[,step]) 21 | 22 | Pull the data values off the rrd file and calculate the standard deviation. Nan 23 | values get ignored in this process. 24 | 25 | =cut 26 | 27 | sub get_stddev{ 28 | my $rrd = shift; 29 | my $ds = shift; 30 | my $cf = shift; 31 | my $start = shift; 32 | my $end = shift; 33 | my $step = shift; 34 | my ($realstart,$realstep,$names,$array) = RRDs::fetch $rrd, $cf, '--start',$start, '--end',$end,($step ? ('--resolution',$step):()); 35 | if (my $err = RRDs::error){ 36 | warn $err 37 | }; 38 | my $idx = 0; 39 | for (@$names){ 40 | last if $ds eq $_; 41 | $idx ++; 42 | } 43 | my $sum = 0; 44 | my $sqsum = 0; 45 | my $cnt = 0; 46 | foreach my $line (@$array){ 47 | my $val = $line->[$idx]; 48 | if (defined $val){ 49 | $cnt++; 50 | $sum += $val; 51 | $sqsum += $val**2; 52 | } 53 | } 54 | return undef unless $cnt; 55 | my $sqdev = 1.0 / $cnt * ( $sqsum - $sum**2 / $cnt ); 56 | return $sqdev < 0.0 ? 0.0 : sqrt($sqdev); 57 | } 58 | 59 | 60 | 61 | 1; 62 | 63 | __END__ 64 | 65 | =head1 COPYRIGHT 66 | 67 | Copyright 2007 by Tobias Oetiker 68 | 69 | =head1 LICENSE 70 | 71 | This program is free software; you can redistribute it 72 | and/or modify it under the terms of the GNU General Public 73 | License as published by the Free Software Foundation; either 74 | version 2 of the License, or (at your option) any later 75 | version. 76 | 77 | This program is distributed in the hope that it will be 78 | useful, but WITHOUT ANY WARRANTY; without even the implied 79 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 80 | PURPOSE. See the GNU General Public License for more 81 | details. 82 | 83 | You should have received a copy of the GNU General Public 84 | License along with this program; if not, write to the Free 85 | Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 86 | 02139, USA. 87 | 88 | =head1 AUTHOR 89 | 90 | Tobias Oetiker Etobi@oetiker.chE 91 | 92 | =cut 93 | -------------------------------------------------------------------------------- /lib/Smokeping/Slave.pm: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | package Smokeping::Slave; 3 | use warnings; 4 | use strict; 5 | use Data::Dumper; 6 | use Storable qw(nstore retrieve); 7 | use Digest::HMAC_MD5 qw(hmac_md5_hex); 8 | use LWP::UserAgent; 9 | use Safe; 10 | use Smokeping; 11 | # keep this in sync with the Slave.pm part 12 | # only update if you have to force a parallel upgrade 13 | my $PROTOCOL = "2"; 14 | 15 | =head1 NAME 16 | 17 | Smokeping::Slave - Slave functionality for Smokeping 18 | 19 | =head1 OVERVIEW 20 | 21 | The Module implements the functionality required to run in slave mode. 22 | 23 | =head2 IMPLEMENTATION 24 | 25 | =head3 submit_results 26 | 27 | In slave mode we just hit our targets and submit the results to the server. 28 | If we can not get to the server, we submit the results in the next round. 29 | The server in turn sends us new config information if it sees that ours is 30 | out of date. 31 | 32 | =cut 33 | 34 | sub get_results; 35 | sub get_results { 36 | my $slave_cfg = shift; 37 | my $cfg = shift; 38 | my $probes = shift; 39 | my $tree = shift; 40 | my $name = shift; 41 | my $justthisprobe = shift; # if defined, update only the targets probed by this probe 42 | my $probe = $tree->{probe}; 43 | my $results = []; 44 | return [] unless $cfg; 45 | foreach my $prop (keys %{$tree}) { 46 | if (ref $tree->{$prop} eq 'HASH'){ 47 | my $subres = get_results $slave_cfg, $cfg, $probes, $tree->{$prop}, $name."/$prop", $justthisprobe; 48 | push @{$results}, @{$subres}; 49 | } 50 | next unless defined $probe; 51 | next if defined $justthisprobe and $probe ne $justthisprobe; 52 | my $probeobj = $probes->{$probe}; 53 | if ($prop eq 'host') { 54 | #print "update $name\n"; 55 | my $updatestring = $probeobj->rrdupdate_string($tree); 56 | push @$results, "$name\t".time()."\t$updatestring"; 57 | } 58 | } 59 | return $results; 60 | } 61 | 62 | sub submit_results { 63 | my $slave_cfg = shift; 64 | my $cfg = shift; 65 | my $myprobe = shift; 66 | my $probes = shift; 67 | my $store = $slave_cfg->{cache_dir}."/data"; 68 | $store .= "_$myprobe" if $myprobe; 69 | $store .= ".cache"; 70 | my $restore = -f $store ? retrieve $store : []; 71 | unlink $store; 72 | my $new = get_results($slave_cfg, $cfg, $probes, $cfg->{Targets}, '', $myprobe); 73 | push @$restore, @$new; 74 | my $data_dump = join("\n",@{$restore}) || ""; 75 | my $ua = LWP::UserAgent->new( 76 | agent => 'smokeping-slave/1.0', 77 | timeout => 60, 78 | env_proxy => 1 ); 79 | 80 | my $response = $ua->post( 81 | $slave_cfg->{master_url}, 82 | Content_Type => 'form-data', 83 | Content => [ 84 | slave => $slave_cfg->{slave_name}, 85 | key => hmac_md5_hex($data_dump,$slave_cfg->{shared_secret}), 86 | protocol => $PROTOCOL, 87 | data => $data_dump, 88 | config_time => $cfg->{__last} || 0, 89 | ], 90 | ); 91 | if ($response->is_success){ 92 | my $data = $response->content; 93 | my $key = $response->header('Key'); 94 | my $protocol = $response->header('Protocol') || '?'; 95 | 96 | if ($response->header('Content-Type') ne 'application/smokeping-config'){ 97 | warn "$data\n" unless $data =~ /OK/; 98 | Smokeping::do_debuglog("Sent data to Server. Server said $data"); 99 | return undef; 100 | }; 101 | 102 | if ($protocol ne $PROTOCOL){ 103 | warn "WARNING $slave_cfg->{master_url} sent data with protocol $protocol. Expected $PROTOCOL."; 104 | return undef; 105 | } 106 | if (hmac_md5_hex($data,$slave_cfg->{shared_secret}) ne $key){ 107 | warn "WARNING $slave_cfg->{master_url} sent data with wrong key"; 108 | return undef; 109 | } 110 | # Safe seems to reset SIG on at least FreeBSD, causing slave to crash after first reload 111 | # since all handlers are gone. 112 | my %sig_backup = %SIG; 113 | 114 | my $zone = new Safe; 115 | # $zone->permit_only(???); #input welcome as to good settings 116 | my $config = $zone->reval($data); 117 | 118 | %SIG = %sig_backup; 119 | 120 | if ($@){ 121 | warn "WARNING evaluating new config from server failed: $@ --\n$data"; 122 | } elsif (defined $config and ref $config eq 'HASH'){ 123 | $config->{General}{piddir} = $slave_cfg->{pid_dir}; 124 | Smokeping::do_log("Sent data to Server and got new config in response."); 125 | return $config; 126 | } 127 | } else { 128 | # ok did not manage to get our data to the server. 129 | # we store the result so that we can try again later. 130 | warn "WARNING Master said ".$response->status_line()."\n"; 131 | nstore $restore, $store; 132 | } 133 | return undef; 134 | } 135 | 136 | 1; 137 | 138 | __END__ 139 | 140 | =head1 COPYRIGHT 141 | 142 | Copyright 2007 by Tobias Oetiker 143 | 144 | =head1 LICENSE 145 | 146 | This program is free software; you can redistribute it 147 | and/or modify it under the terms of the GNU General Public 148 | License as published by the Free Software Foundation; either 149 | version 2 of the License, or (at your option) any later 150 | version. 151 | 152 | This program is distributed in the hope that it will be 153 | useful, but WITHOUT ANY WARRANTY; without even the implied 154 | warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 155 | PURPOSE. See the GNU General Public License for more 156 | details. 157 | 158 | You should have received a copy of the GNU General Public 159 | License along with this program; if not, write to the Free 160 | Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 161 | 02139, USA. 162 | 163 | =head1 AUTHOR 164 | 165 | Tobias Oetiker Etobi@oetiker.chE 166 | 167 | =cut 168 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/Avgratio.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::Avgratio; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::Avgratio - detect changes in average median latency 6 | 7 | =head1 OVERVIEW 8 | 9 | The Avgratio matcher establishes a historic average median latency over 10 | several measurement rounds. It compares this average, against a second 11 | average latency value again build over several rounds of measurement. 12 | 13 | =head1 DESCRIPTION 14 | 15 | Call the matcher with the following sequence: 16 | 17 | type = matcher 18 | pattern = Avgratio(historic=>a,current=>b,comparator=>o,percentage=>p) 19 | 20 | =over 21 | 22 | =item historic 23 | 24 | The number of median values to use for building the 'historic' average. 25 | 26 | =item current 27 | 28 | The number of median values to use for building the 'current' average. 29 | 30 | =item comparator 31 | 32 | Which comparison operator should be used to compare current/historic with percentage. 33 | 34 | =item percentage 35 | 36 | Right hand side of the comparison. 37 | 38 | =back 39 | 40 | old <--- historic ---><--- current ---> now 41 | 42 | =head1 EXAMPLE 43 | 44 | Take build the average median latency over 10 samples, use this to divide the 45 | current average latency built over 2 samples and check if it is bigger than 46 | 150%. 47 | 48 | Avgratio(historic=>10,current=>2,comparator=>'>',percentage=>150); 49 | 50 | avg(current)/avg(historic) > 150/100 51 | 52 | This means the matcher will activate when the current latency average is 53 | more than 1.5 times the historic latency average established over the last 54 | 10 rounds of measurement. 55 | 56 | =head1 COPYRIGHT 57 | 58 | Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. 59 | 60 | =head1 SPONSORSHIP 61 | 62 | The development of this matcher has been sponsored by Virtela Communications, L. 63 | 64 | =head1 LICENSE 65 | 66 | This program is free software; you can redistribute it and/or modify 67 | it under the terms of the GNU General Public License as published by 68 | the Free Software Foundation; either version 2 of the License, or 69 | (at your option) any later version. 70 | 71 | This program is distributed in the hope that it will be useful, 72 | but WITHOUT ANY WARRANTY; without even the implied warranty of 73 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 74 | GNU General Public License for more details. 75 | 76 | You should have received a copy of the GNU General Public License 77 | along with this program; if not, write to the Free Software 78 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 79 | 80 | =head1 AUTHOR 81 | 82 | Tobias Oetiker 83 | 84 | =cut 85 | 86 | use vars qw($VERSION); 87 | 88 | 89 | $VERSION = 1.0; 90 | 91 | use strict; 92 | use base qw(Smokeping::matchers::base); 93 | use Carp; 94 | 95 | sub new(@) 96 | { 97 | my $class = shift; 98 | my $rules = { 99 | historic=>'\d+', 100 | current=>'\d+', 101 | comparator=>'(<|>|<=|>=|==)', 102 | percentage=>'\d+(\.\d+)?' }; 103 | 104 | my $self = $class->SUPER::new($rules,@_); 105 | $self->{param}{sub} = eval "sub {\$_[0] ".$self->{param}{comparator}." \$_[1]}"; 106 | croak "compiling comparator $self->{param}{comparator}: $@" if $@; 107 | $self->{param}{value} = $self->{param}{percentage}/100; 108 | return $self; 109 | } 110 | 111 | sub Length($) 112 | { 113 | my $self = shift; 114 | return $self->{param}{historic} + $self->{param}{current}; 115 | } 116 | 117 | sub Desc ($) { 118 | croak "Detect changes in average median latency"; 119 | } 120 | 121 | sub avg(@){ 122 | my $sum=0; 123 | my $cnt=0; 124 | for (@_){ 125 | next unless defined $_; 126 | $sum += $_; 127 | $cnt ++; 128 | } 129 | return $sum/$cnt if $cnt; 130 | return undef; 131 | } 132 | 133 | sub Test($$) 134 | { my $self = shift; 135 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 136 | my $len = $self->Length; 137 | my $rlen = scalar @{$data->{rtt}}; 138 | return undef 139 | if $rlen < $len 140 | or (defined $data->{rtt}[-$len] and $data->{rtt}[-$len] eq 'S'); 141 | my $ac = $self->{param}{historic}; 142 | my $bc = $self->{param}{current}; 143 | my $cc = $ac +$bc; 144 | my $ha = avg(@{$data->{rtt}}[-$cc..-$bc-1]); 145 | my $ca = avg(@{$data->{rtt}}[-$bc..-1]); 146 | return undef unless $ha and $ca; 147 | return &{$self->{param}{sub}}($ca/$ha,$self->{param}{value}); 148 | } 149 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/CheckLatency.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::CheckLatency; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::CheckLatency - Edge triggered alert to check latency is under a value for x number of samples 6 | 7 | =head1 DESCRIPTION 8 | 9 | Call the matcher with the following sequence: 10 | 11 | type = matcher 12 | edgetrigger = yes 13 | pattern = CheckLatency(l=>latency to check against,x=>num samples required for a match) 14 | 15 | This will create a matcher which checks for "l" latency or greater over "x" samples before raising, 16 | and will hold the alert until "x" samples under "l" before clearing 17 | 18 | =head1 COPYRIGHT 19 | 20 | Copyright (c) 2006 Dylan C Vanderhoof, Semaphore Corporation 21 | 22 | =head1 LICENSE 23 | 24 | This program is free software; you can redistribute it and/or modify 25 | it under the terms of the GNU General Public License as published by 26 | the Free Software Foundation; either version 2 of the License, or 27 | (at your option) any later version. 28 | 29 | This program is distributed in the hope that it will be useful, 30 | but WITHOUT ANY WARRANTY; without even the implied warranty of 31 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32 | GNU General Public License for more details. 33 | 34 | You should have received a copy of the GNU General Public License 35 | along with this program; if not, write to the Free Software 36 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 37 | 38 | =head1 AUTHOR 39 | 40 | Dylan Vanderhoof 41 | 42 | =cut 43 | 44 | use strict; 45 | use base qw(Smokeping::matchers::base); 46 | use vars qw($VERSION); 47 | $VERSION = 1.0; 48 | use Carp; 49 | use List::Util qw(min max); 50 | 51 | # I never checked why Median works, but for some reason the first part of the hash was being passed as the rules instead 52 | sub new(@) { 53 | my $class = shift; 54 | my $rules = { 55 | l => '\d+', 56 | x => '\d+' 57 | }; 58 | my $self = $class->SUPER::new( $rules, @_ ); 59 | return $self; 60 | } 61 | 62 | # how many values should we require before raising? 63 | sub Length($) { 64 | my $self = shift; 65 | return $self->{param}{x}; # Because we're edge triggered, we don't need any more than the required samples 66 | } 67 | 68 | sub Desc ($) { 69 | croak "Monitor latency with a cooldown period for clearing the alert"; 70 | } 71 | 72 | sub Test($$) { 73 | my $self = shift; 74 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 75 | my $target = $self->{param}{l} / 1000; # Smokeping reports in seconds 76 | my $count = 0; 77 | my $rtt; 78 | my @rtts = @{ $data->{rtt} }; 79 | my $x = min($self->{param}{x}, scalar @{ $data->{rtt} }); 80 | 81 | #Iterate thru last x number of samples, starting with the most recent 82 | for (my $i=1;$i<=$x;$i++) { 83 | $rtt = $data->{rtt}[$_-$i]; 84 | 85 | # If there's an S in the array anywhere, return prevmatch 86 | if ( $rtt =~ /S/ ) { return $data->{prevmatch}; } 87 | if ( $data->{prevmatch} ) { 88 | 89 | # Alert has already been raised. Evaluate and count consecutive rtt values that are below threshold. 90 | if ( $rtt < $target ) { $count++; } 91 | } else { 92 | 93 | # Alert is not raised. Evaluate and count consecutive rtt values that are above threshold. 94 | if ( $rtt >= $target ) { $count++; } 95 | } 96 | } 97 | if ( $count >= $self->{param}{x} ) { 98 | return !$data->{prevmatch}; 99 | } 100 | 101 | return $data->{prevmatch}; 102 | } 103 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/CheckLoss.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::CheckLoss; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::CheckLoss - Edge triggered alert to check loss is under a value for x number of samples 6 | 7 | =head1 DESCRIPTION 8 | 9 | Call the matcher with the following sequence: 10 | 11 | type = matcher 12 | edgetrigger = yes 13 | pattern = CheckLoss(l=>loss to check against,x=>num samples required for a match) 14 | 15 | This will create a matcher which checks for "l" loss or greater over "x" samples before raising, 16 | and will hold the alert until "x" samples under "l" before clearing 17 | 18 | =head1 COPYRIGHT 19 | 20 | Copyright (c) 2006 Dylan C Vanderhoof, Semaphore Corporation 21 | 22 | =head1 LICENSE 23 | 24 | This program is free software; you can redistribute it and/or modify 25 | it under the terms of the GNU General Public License as published by 26 | the Free Software Foundation; either version 2 of the License, or 27 | (at your option) any later version. 28 | 29 | This program is distributed in the hope that it will be useful, 30 | but WITHOUT ANY WARRANTY; without even the implied warranty of 31 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32 | GNU General Public License for more details. 33 | 34 | You should have received a copy of the GNU General Public License 35 | along with this program; if not, write to the Free Software 36 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 37 | 38 | =head1 AUTHOR 39 | 40 | Dylan Vanderhoof 41 | 42 | =cut 43 | 44 | use strict; 45 | use base qw(Smokeping::matchers::base); 46 | use vars qw($VERSION); 47 | $VERSION = 1.0; 48 | use Carp; 49 | use List::Util qw(min max); 50 | 51 | # I never checked why Median works, but for some reason the first part of the hash was being passed as the rules instead 52 | sub new(@) { 53 | my $class = shift; 54 | my $rules = { 55 | l => '\d+', 56 | x => '\d+' 57 | }; 58 | my $self = $class->SUPER::new( $rules, @_ ); 59 | return $self; 60 | } 61 | 62 | # how many values should we require before raising? 63 | sub Length($) { 64 | my $self = shift; 65 | return $self->{param}{x}; # Because we're edge triggered, we don't need any more than the required samples 66 | } 67 | 68 | sub Desc ($) { 69 | croak "Monitor loss with a cooldown period for clearing the alert"; 70 | } 71 | 72 | sub Test($$) { 73 | my $self = shift; 74 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 75 | my $target = $self->{param}{l}; 76 | my $count = 0; 77 | my $loss; 78 | my $x = min($self->{param}{x}, scalar @{ $data->{loss} }); 79 | 80 | #Iterate thru last x number of samples, starting with the most recent 81 | for (my $i=1;$i<=$x;$i++) { 82 | $loss = $data->{loss}[$_-$i]; 83 | # If there's an S in the array anywhere, return prevmatch 84 | if ( $loss =~ /S/ ) { return $data->{prevmatch}; } 85 | if ( $data->{prevmatch} ) { 86 | 87 | # Alert has already been raised. Evaluate and count consecutive loss values that are below threshold. 88 | if ( $loss < $target ) { $count++; } 89 | } else { 90 | 91 | # Alert is not raised. Evaluate and count consecutive loss values that are above threshold. 92 | if ( $loss >= $target ) { $count++; } 93 | } 94 | } 95 | if ( $count >= $self->{param}{x} ) { 96 | return !$data->{prevmatch}; 97 | } 98 | 99 | return $data->{prevmatch}; 100 | } 101 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/ExpLoss.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::ExpLoss; 2 | =head1 NAME 3 | 4 | Smokeping::matchers::ExpLoss - exponential weighting matcher for packet loss 5 | with RMON-like thresholds 6 | 7 | =head1 DESCRIPTION 8 | 9 | Match against exponential weighted average of last samples, thus new values 10 | are more valuable as old ones. Two thresholds - rising and falling - produce 11 | hysteresis loop like in RMON alert subsystem. If the average reaches the 12 | "rising" threshold, matcher go to the "match" state and hold It until the 13 | average drops under the "falling" threshold. 14 | 15 | Call the matcher with the following sequence: 16 | 17 | type = matcher 18 | pattern = ExpLoss(hist => , rising=> \ 19 | [,falling => ] [,skip=>] [,fast=>]) 20 | 21 | Arguments: 22 | hist - number of samples to weight against; weight will be disposed with 23 | exponential decreasing manner from newest to oldest, so that the 24 | oldest sample would have 1% significance; 25 | rising - rising threshold for packet loss, 0-100% 26 | falling - falling threshold for packet loss, default is 27 | skip - skip number of samples after startup before "fire" alerts. 28 | fast - use samples for fast transition: if the values of last 29 | samples more then - take "match" state, if less then 30 | - take "no match" state. 31 | 32 | Note: 33 | If the actual history is less then value then this value is taken 34 | as the actual history. 35 | 36 | =head1 COPYRIGHT 37 | 38 | Copyright (c) 2008 Veniamin Konoplev 39 | 40 | Developed in cooperation with EU EGEE project 41 | 42 | =head1 LICENSE 43 | 44 | This program is free software; you can redistribute it and/or modify 45 | it under the terms of the GNU General Public License as published by 46 | the Free Software Foundation; either version 2 of the License, or 47 | (at your option) any later version. 48 | 49 | This program is distributed in the hope that it will be useful, 50 | but WITHOUT ANY WARRANTY; without even the implied warranty of 51 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 52 | GNU General Public License for more details. 53 | 54 | You should have received a copy of the GNU General Public License 55 | along with this program; if not, write to the Free Software 56 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 57 | 58 | =head1 AUTHOR 59 | 60 | Veniamin Konoplev Evkonoplev@acm.orgE 61 | 62 | =cut 63 | 64 | use strict; 65 | use base qw(Smokeping::matchers::base); 66 | use vars qw($VERSION); 67 | $VERSION = 1.0; 68 | use Carp; 69 | 70 | sub new(@) { 71 | my $class = shift; 72 | my $rules = { 73 | hist => '\d+', 74 | rising => '\d+(\.\d+)?', 75 | falling => '\d+(\.\d+)?', 76 | skip => '\d+', 77 | fast => '\d+', 78 | }; 79 | my $self = $class->SUPER::new( $rules, @_ ); 80 | return $self; 81 | } 82 | 83 | # how many values should we require before raising? 84 | sub Length($) { 85 | my $self = shift; 86 | return $self->{param}{hist}; # 87 | } 88 | 89 | sub Desc ($) { 90 | croak "Monitor if exponential weighted loss is in interval"; 91 | } 92 | 93 | sub Test($$) { 94 | my $self = shift; 95 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 96 | 97 | my $hist = $self->{param}{hist}; # history length 98 | my $skip = ($self->{param}{skip} || 0); # skip samples before start 99 | my $fast = ($self->{param}{fast} || 0); # use last samples for fast alerts 100 | 101 | return undef if scalar(@{ $data->{loss}}) <= $skip+1; 102 | 103 | # calculate alpha factor to obtain 1% significance 104 | # of the old probes at the boundary 105 | my $alfa = 1-0.01**(1/$hist); 106 | 107 | my $rising = $self->{param}{rising}; 108 | my $falling = $self->{param}{falling} // $rising; 109 | 110 | my $result = 0; # initialize the filter as zero; 111 | my $loss; 112 | my $sum = 0; 113 | my $num = 0; 114 | my $rising_cnt = 0; 115 | my $falling_cnt = 0; 116 | foreach $loss ( @{ $data->{loss} } ) { 117 | # If there's an S in the array anywhere, return prevmatch 118 | next if ( $loss =~ /S/ or $loss =~ /U/); 119 | 120 | # update the filter 121 | $result = (1-$alfa)*$result+$alfa*$loss; 122 | $sum += $loss; 123 | $num++; 124 | if ($fast) { 125 | $rising_cnt = ($loss >= $rising) ? $rising_cnt + 1 : 0; 126 | $falling_cnt = ($loss <= $falling) ? $falling_cnt + 1 : 0; 127 | } 128 | } 129 | 130 | return undef if $num == 0; 131 | 132 | # 133 | if ($fast) { 134 | return 1 if $rising_cnt >= $fast; 135 | return "" if $falling_cnt >= $fast; 136 | } 137 | # correct filter result as if it was initialized with "average" 138 | $result += ($sum/$num)*((1-$alfa)**$num); 139 | 140 | my $res = (($result >= $rising) or ($data->{prevmatch} and $result >= $falling)); 141 | 142 | # some debug stuff 143 | if (0) { 144 | my $d = `date`; 145 | chomp $d; 146 | my $array = join ":", @{ $data->{loss}}; 147 | `echo $d $data->{target} $array $result. >> /tmp/matcher.log` if $rising == 0; 148 | } 149 | return $res; 150 | } 151 | 152 | 1; 153 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/Median.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::Median; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::Median - Find persistent changes in latency 6 | 7 | =head1 OVERVIEW 8 | 9 | The idea behind this matcher is to find sustained changes in latency. 10 | 11 | The median matcher takes a number of past median latencies. It splits the latencies into 12 | two groups (old and new) and again finds the median for each groups. If the 13 | difference between the two medians is bigger than a certain value, it will 14 | give a match. 15 | 16 | =head1 DESCRIPTION 17 | 18 | Call the matcher with the following sequence: 19 | 20 | type = matcher 21 | pattern = Median(old=>x,new=>y,diff=>z) 22 | 23 | This will create a matcher which consumes x+y latency-datapoints, builds the 24 | two medians and the matches if the difference between the median latency is 25 | larger than z seconds. 26 | 27 | =head1 COPYRIGHT 28 | 29 | Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. 30 | 31 | =head1 LICENSE 32 | 33 | This program is free software; you can redistribute it and/or modify 34 | it under the terms of the GNU General Public License as published by 35 | the Free Software Foundation; either version 2 of the License, or 36 | (at your option) any later version. 37 | 38 | This program is distributed in the hope that it will be useful, 39 | but WITHOUT ANY WARRANTY; without even the implied warranty of 40 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 41 | GNU General Public License for more details. 42 | 43 | You should have received a copy of the GNU General Public License 44 | along with this program; if not, write to the Free Software 45 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 46 | 47 | =head1 AUTHOR 48 | 49 | Tobias Oetiker 50 | 51 | =cut 52 | 53 | use strict; 54 | use base qw(Smokeping::matchers::base); 55 | use vars qw($VERSION); 56 | $VERSION = 1.0; 57 | use Carp; 58 | 59 | sub new(@) 60 | { 61 | my $class = shift; 62 | my $rules = { 63 | old=>'\d+', 64 | new=>'\d+', 65 | diff=>'\d+(\.\d+)?' }; 66 | 67 | my $self = $class->SUPER::new($rules,@_); 68 | return $self; 69 | } 70 | 71 | # how many values does the matcher need to do it's magic 72 | sub Length($) 73 | { 74 | my $self = shift; 75 | return $self->{param}{old} + $self->{param}{new}; 76 | } 77 | 78 | sub Desc ($) { 79 | croak "Find changes in median latency"; 80 | } 81 | 82 | sub Test($$) 83 | { my $self = shift; 84 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 85 | my $ac = $self->{param}{old}; 86 | my $bc = $self->{param}{new}; 87 | my $cc = $ac +$bc; 88 | my $count = scalar @{$data->{rtt}}; 89 | $cc = $count if $count < $cc; 90 | $bc = $count if $count < $bc; 91 | my $oldm = robust_median(@{$data->{rtt}}[-$cc..-$bc-1]); 92 | my $newm = robust_median(@{$data->{rtt}}[-$bc..-1]); 93 | return abs($oldm-$newm) > $self->{param}{diff}; 94 | } 95 | 96 | sub robust_median(@){ 97 | my @numbers = sort {$a <=> $b} grep { defined $_ and $_ =~ /\d/ } @_; 98 | my $count = $#numbers; 99 | return 0 if $count < 0; 100 | return ($count / 2 == int($count/2)) ? $numbers[$count/2] : ($numbers[$count/2+0.5] + $numbers[$count/2-0.5])/2; 101 | } 102 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/Medratio.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::Medratio; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::Medratio - detect changes in the latency median 6 | 7 | =head1 OVERVIEW 8 | 9 | The Medratio matcher establishes a historic median latency over 10 | several measurement rounds. It compares this median, against a second 11 | median latency value again build over several rounds of measurement. 12 | 13 | By looking at the median value this matcher is largely immune against spikes 14 | and will only react to long term developments. 15 | 16 | =head1 DESCRIPTION 17 | 18 | Call the matcher with the following sequence: 19 | 20 | type = matcher 21 | pattern = Medratio(historic=>a,current=>b,comparator=>o,percentage=>p) 22 | 23 | =over 24 | 25 | =item historic 26 | 27 | The number of values to use for building the 'historic' median. 28 | 29 | =item current 30 | 31 | The number of values to use for building the 'current' median. 32 | 33 | =item comparator 34 | 35 | Which comparison operator should be used to compare current/historic with percentage. 36 | 37 | =item percentage 38 | 39 | Right hand side of the comparison. 40 | 41 | =back 42 | 43 | old <--- historic ---><--- current ---> now 44 | 45 | =head1 EXAMPLE 46 | 47 | Take the 12 last median values. Build the median out of the first 10 48 | and the median from the other 2 values. Divide the results and decide 49 | if it is bigger than 150 percent. 50 | 51 | Medratio(historic=>10,current=>2,comparator=>'>',percentage=>150); 52 | 53 | med(current)/med(historic) > 150/100 54 | 55 | This means the matcher will activate when the current latency median is 56 | more than 1.5 times the historic latency median established over the last 57 | 10 rounds of measurement. 58 | 59 | =head1 COPYRIGHT 60 | 61 | Copyright (c) 2006 by OETIKER+PARTNER AG. All rights reserved. 62 | 63 | =head1 SPONSORSHIP 64 | 65 | The development of this matcher has been paid for by Virtela 66 | Communications, L. 67 | 68 | =head1 LICENSE 69 | 70 | This program is free software; you can redistribute it and/or modify 71 | it under the terms of the GNU General Public License as published by 72 | the Free Software Foundation; either version 2 of the License, or 73 | (at your option) any later version. 74 | 75 | This program is distributed in the hope that it will be useful, 76 | but WITHOUT ANY WARRANTY; without even the implied warranty of 77 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 78 | GNU General Public License for more details. 79 | 80 | You should have received a copy of the GNU General Public License 81 | along with this program; if not, write to the Free Software 82 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 83 | 84 | =head1 AUTHOR 85 | 86 | Tobias Oetiker 87 | 88 | =cut 89 | 90 | use vars qw($VERSION); 91 | 92 | 93 | $VERSION = 1.0; 94 | 95 | use strict; 96 | use base qw(Smokeping::matchers::Avgratio); 97 | use Carp; 98 | 99 | sub Desc ($) { 100 | croak "Detect changes in median latency"; 101 | } 102 | 103 | sub Test($$) 104 | { my $self = shift; 105 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 106 | my $len = $self->Length; 107 | my $rlen = scalar @{$data->{rtt}}; 108 | return undef 109 | if $rlen < $len 110 | or (defined $data->{rtt}[-$len] and $data->{rtt}[-$len] eq 'S'); 111 | my $ac = $self->{param}{historic}; 112 | my $bc = $self->{param}{current}; 113 | my $cc = $ac +$bc; 114 | my $hm = (sort {$a <=> $b} @{$data->{rtt}}[-$cc..-$bc-1])[int($ac/2)]; 115 | my $cm = (sort {$a <=> $b} @{$data->{rtt}}[-$bc..-1])[int($bc/2)]; 116 | return undef unless $hm and $cm; 117 | return &{$self->{param}{sub}}($cm/$hm,$self->{param}{value}); 118 | } 119 | -------------------------------------------------------------------------------- /lib/Smokeping/matchers/base.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::matchers::base; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::matchers::base - Base Class for implementing SmokePing Matchers 6 | 7 | =head1 OVERVIEW 8 | 9 | This is the base class for writing SmokePing matchers. Every matcher must 10 | inherit from the base class and provide it's own methods for the 'business' 11 | logic. 12 | 13 | Note that the actual matchers must have at least one capital letter in their 14 | name, to differentiate them from the base class(es). 15 | 16 | =head1 DESCRIPTION 17 | 18 | Every matcher must provide the following methods: 19 | 20 | =cut 21 | 22 | use vars qw($VERSION); 23 | use Carp; 24 | 25 | $VERSION = 1.0; 26 | 27 | use strict; 28 | 29 | =head2 new 30 | 31 | The new method expects hash elements as an argument 32 | eg new({x=>'\d+',y=>'\d+'},x=>1,y=>2). The first part is 33 | a syntax rule for the arguments it should expect and the second part 34 | are the arguments itself. The first part will be supplied 35 | by the child class as it calls the parent method. 36 | 37 | =cut 38 | 39 | sub new(@) 40 | { 41 | my $this = shift; 42 | my $class = ref($this) || $this; 43 | my $rules = shift; 44 | my $self = { param => { @_ } }; 45 | foreach my $key (keys %{$self->{param}}){ 46 | my $regex = $rules->{$key}; 47 | croak "key '$key' is not known by this matcher" unless defined $rules->{$key}; 48 | croak "key '$key' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/; 49 | } 50 | bless $self, $class; 51 | return $self; 52 | } 53 | 54 | =head2 Length 55 | 56 | The Length method returns the number of values the 57 | matcher will expect from SmokePing. This method must 58 | be overridden by the children of the base class. 59 | 60 | =cut 61 | 62 | sub Length($) 63 | { 64 | my $self = shift; 65 | croak "SequenceLength must be overridden by the subclass"; 66 | } 67 | 68 | =head2 Desc 69 | 70 | Simply return the description of the function. This method must 71 | be overwritten by a children of the base class. 72 | 73 | =cut 74 | 75 | 76 | sub Desc ($) { 77 | croak "MatcherDesc must be overridden by the subclass"; 78 | } 79 | 80 | =head2 Test 81 | 82 | Run the matcher and return true or false. The Test method is called 83 | with a hash containing two arrays giving it access to both rtt and loss values. 84 | 85 | my $data=shift; 86 | my @rtt = @{$data->{rtt}}; 87 | my @loss = @{$data->{loss}}; 88 | 89 | The arrays are ordered from old to new. 90 | 91 | @rdd[old..new] 92 | 93 | There may be more than the expected number of elements in this array. Address them with 94 | $x[-1] to $x[-max]. 95 | 96 | There's also a key called 'prevmatch' in the hash. It contains the 97 | value returned by the previous call of the 'Test' method. This allows 98 | for somewhat more intelligent alerting due to state awareness. 99 | 100 | my $prevmatch = $data->{prevmatch}; 101 | 102 | =cut 103 | 104 | sub Test($$) 105 | { my $self = shift; 106 | my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} 107 | croak "Match must be overridden by the subclass"; 108 | 109 | } 110 | 111 | =head1 COPYRIGHT 112 | 113 | Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. 114 | 115 | =head1 LICENSE 116 | 117 | This program is free software; you can redistribute it and/or modify 118 | it under the terms of the GNU General Public License as published by 119 | the Free Software Foundation; either version 2 of the License, or 120 | (at your option) any later version. 121 | 122 | This program is distributed in the hope that it will be useful, 123 | but WITHOUT ANY WARRANTY; without even the implied warranty of 124 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 125 | GNU General Public License for more details. 126 | 127 | You should have received a copy of the GNU General Public License 128 | along with this program; if not, write to the Free Software 129 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 130 | 131 | =head1 AUTHOR 132 | 133 | Tobias Oetiker 134 | 135 | =cut 136 | -------------------------------------------------------------------------------- /lib/Smokeping/pingMIB.pm: -------------------------------------------------------------------------------- 1 | # 2 | # 3 | # a few variable definitions to use pingMIB 4 | # 5 | # Bill Fenner, 10/23/06 6 | # Based on ciscoRttMonMIB.pm 7 | # 8 | 9 | package Smokeping::pingMIB; 10 | 11 | require 5.004; 12 | 13 | use vars qw($VERSION); 14 | use Exporter; 15 | 16 | use BER; 17 | use SNMP_Session; 18 | use SNMP_util "0.89"; 19 | 20 | $VERSION = '0.1'; 21 | 22 | @ISA = qw(Exporter); 23 | 24 | sub version () { $VERSION; }; 25 | 26 | # Scalars: 27 | snmpmapOID("pingMaxConcurrentRequests", "1.3.6.1.2.1.80.1.1.0"); 28 | 29 | # pingCtlTable 30 | snmpmapOID("pingCtlOwnerIndex", "1.3.6.1.2.1.80.1.2.1.1"); 31 | snmpmapOID("pingCtlTestName", "1.3.6.1.2.1.80.1.2.1.2"); 32 | snmpmapOID("pingCtlTargetAddressType", "1.3.6.1.2.1.80.1.2.1.3"); 33 | snmpmapOID("pingCtlTargetAddress", "1.3.6.1.2.1.80.1.2.1.4"); 34 | snmpmapOID("pingCtlDataSize", "1.3.6.1.2.1.80.1.2.1.5"); 35 | snmpmapOID("pingCtlTimeOut", "1.3.6.1.2.1.80.1.2.1.6"); 36 | snmpmapOID("pingCtlProbeCount", "1.3.6.1.2.1.80.1.2.1.7"); 37 | snmpmapOID("pingCtlAdminStatus", "1.3.6.1.2.1.80.1.2.1.8"); 38 | snmpmapOID("pingCtlDataFill", "1.3.6.1.2.1.80.1.2.1.9"); 39 | snmpmapOID("pingCtlFrequency", "1.3.6.1.2.1.80.1.2.1.10"); 40 | snmpmapOID("pingCtlMaxRows", "1.3.6.1.2.1.80.1.2.1.11"); 41 | snmpmapOID("pingCtlStorageType", "1.3.6.1.2.1.80.1.2.1.12"); 42 | snmpmapOID("pingCtlTrapGeneration", "1.3.6.1.2.1.80.1.2.1.13"); 43 | snmpmapOID("pingCtlTrapProbeFailureFilter", "1.3.6.1.2.1.80.1.2.1.14"); 44 | snmpmapOID("pingCtlTrapTestFailureFilter", "1.3.6.1.2.1.80.1.2.1.15"); 45 | snmpmapOID("pingCtlType", "1.3.6.1.2.1.80.1.2.1.16"); 46 | snmpmapOID("pingCtlDescr", "1.3.6.1.2.1.80.1.2.1.17"); 47 | snmpmapOID("pingCtlSourceAddressType", "1.3.6.1.2.1.80.1.2.1.18"); 48 | snmpmapOID("pingCtlSourceAddress", "1.3.6.1.2.1.80.1.2.1.19"); 49 | snmpmapOID("pingCtlIfIndex", "1.3.6.1.2.1.80.1.2.1.20"); 50 | snmpmapOID("pingCtlByPassRouteTable", "1.3.6.1.2.1.80.1.2.1.21"); 51 | snmpmapOID("pingCtlDSField", "1.3.6.1.2.1.80.1.2.1.22"); 52 | snmpmapOID("pingCtlRowStatus", "1.3.6.1.2.1.80.1.2.1.23"); 53 | 54 | # pingResultsTable 55 | snmpmapOID("pingResultsOperStatus", "1.3.6.1.2.1.80.1.3.1.1"); 56 | snmpmapOID("pingResultsIpTargetAddressType", "1.3.6.1.2.1.80.1.3.1.2"); 57 | snmpmapOID("pingResultsIpTargetAddress", "1.3.6.1.2.1.80.1.3.1.3"); 58 | snmpmapOID("pingResultsMinRtt", "1.3.6.1.2.1.80.1.3.1.4"); 59 | snmpmapOID("pingResultsMaxRtt", "1.3.6.1.2.1.80.1.3.1.5"); 60 | snmpmapOID("pingResultsAverageRtt", "1.3.6.1.2.1.80.1.3.1.6"); 61 | snmpmapOID("pingResultsProbeResponses", "1.3.6.1.2.1.80.1.3.1.7"); 62 | snmpmapOID("pingResultsSentProbes", "1.3.6.1.2.1.80.1.3.1.8"); 63 | snmpmapOID("pingResultsRttSumOfSquares", "1.3.6.1.2.1.80.1.3.1.9"); 64 | snmpmapOID("pingResultsLastGoodProbe", "1.3.6.1.2.1.80.1.3.1.10"); 65 | 66 | # pingProbeHistoryTable 67 | snmpmapOID("pingProbeHistoryIndex", "1.3.6.1.2.1.80.1.4.1.1"); 68 | snmpmapOID("pingProbeHistoryResponse", "1.3.6.1.2.1.80.1.4.1.2"); 69 | snmpmapOID("pingProbeHistoryStatus", "1.3.6.1.2.1.80.1.4.1.3"); 70 | snmpmapOID("pingProbeHistoryLastRC", "1.3.6.1.2.1.80.1.4.1.4"); 71 | snmpmapOID("pingProbeHistoryTime", "1.3.6.1.2.1.80.1.4.1.5"); 72 | 73 | # pingImplementationTypeDomains - if we end up supporting other ping types 74 | snmpmapOID("pingIcmpEcho", "1.3.6.1.2.1.80.3.1"); 75 | snmpmapOID("pingUdpEcho", "1.3.6.1.2.1.80.3.2"); 76 | snmpmapOID("pingSnmpQuery", "1.3.6.1.2.1.80.3.3"); 77 | snmpmapOID("pingTcpConnectionAttempt", "1.3.6.1.2.1.80.3.4"); 78 | 79 | # return 1 to indicate that all is ok.. 80 | 1; 81 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/DNS.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::DNS; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use IPC::Open3; 20 | use Symbol; 21 | use Carp; 22 | 23 | sub pod_hash { 24 | return { 25 | name => < < must 30 | point to your copy of the dig program. If it is not installed on 31 | your system yet, you should install bind-utils >= 9.0.0. 32 | 33 | The Probe asks the given host n-times for it's name. Where n is 34 | the amount specified in the config File. 35 | DOC 36 | authors => <<'DOC', 37 | Igor Petrovski , 38 | Carl Elkins , 39 | Andre Stolze , 40 | Niko Tyni , 41 | Chris Poetzel 42 | DOC 43 | }; 44 | } 45 | 46 | my $dig_re=qr/query time:\s+([0-9.]+)\smsec.*/i; 47 | 48 | sub new($$$) 49 | { 50 | my $proto = shift; 51 | my $class = ref($proto) || $proto; 52 | my $self = $class->SUPER::new(@_); 53 | 54 | # no need for this if we run as a cgi 55 | unless ( $ENV{SERVER_SOFTWARE} ) { 56 | 57 | my $call = "$self->{properties}{binary} localhost"; 58 | my $return = `$call 2>&1`; 59 | if ($return =~ m/$dig_re/s){ 60 | $self->{pingfactor} = 1000; 61 | print "### parsing dig output...OK\n"; 62 | } else { 63 | croak "ERROR: output of '$call' does not match $dig_re\n"; 64 | } 65 | }; 66 | 67 | return $self; 68 | } 69 | 70 | sub probevars { 71 | my $class = shift; 72 | return $class->_makevars($class->SUPER::probevars, { 73 | _mandatory => [ 'binary' ], 74 | binary => { 75 | _doc => "The location of your dig binary.", 76 | _example => '/usr/bin/dig', 77 | _sub => sub { 78 | my $val = shift; 79 | return "ERROR: DNS 'binary' does not point to an executable" 80 | unless -f $val and -x _; 81 | return undef; 82 | }, 83 | }, 84 | }); 85 | } 86 | 87 | sub targetvars { 88 | my $class = shift; 89 | return $class->_makevars($class->SUPER::targetvars, { 90 | lookup => { _doc => "Name of the host to look up in the dns.", 91 | _example => "www.example.org", 92 | }, 93 | server => { _doc => "Name of the dns server to use.", 94 | _example => "ns1.someisp.net", 95 | }, 96 | }); 97 | } 98 | 99 | sub ProbeDesc($){ 100 | my $self = shift; 101 | return "DNS requests"; 102 | } 103 | 104 | sub pingone ($){ 105 | my $self = shift; 106 | my $target = shift; 107 | 108 | my $inh = gensym; 109 | my $outh = gensym; 110 | my $errh = gensym; 111 | 112 | my $host = $target->{addr}; 113 | my $lookuphost = $target->{vars}{lookup}; 114 | $lookuphost = $target->{addr} unless defined $lookuphost; 115 | my $dnsserver = $target->{vars}{server} || $host; 116 | my $query = "$self->{properties}{binary} \@$dnsserver $lookuphost"; 117 | 118 | my @times; 119 | 120 | $self->do_debug("query=$query\n"); 121 | for (my $run = 0; $run < $self->pings($target); $run++) { 122 | my $pid = open3($inh,$outh,$errh, $query); 123 | while (<$outh>) { 124 | if (/$dig_re/i) { 125 | push @times, $1; 126 | last; 127 | } 128 | } 129 | waitpid $pid,0; 130 | my $rc = $?; 131 | carp "$query returned with exit code $rc. run with debug enabled to get more information" unless $rc == 0; 132 | close $errh; 133 | close $inh; 134 | close $outh; 135 | } 136 | @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} grep {$_ ne "-"} @times; 137 | 138 | # $self->do_debug("time=@times\n"); 139 | return @times; 140 | } 141 | 142 | 1; 143 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingChargen.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingChargen; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::EchoPing); 19 | use Carp; 20 | 21 | sub pod_hash { 22 | return { 23 | name => < < < variable is not supported. 31 | DOC 32 | authors => <<'DOC', 33 | Niko Tyni 34 | DOC 35 | see_also => < 37 | DOC 38 | } 39 | } 40 | 41 | sub proto_args { 42 | return ("-c"); 43 | } 44 | 45 | sub ProbeDesc($) { 46 | return "TCP Chargen pings using echoping(1)"; 47 | } 48 | 49 | sub targetvars { 50 | my $class = shift; 51 | my $h = $class->SUPER::targetvars; 52 | delete $h->{udp}; 53 | return $h; 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingDNS.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingDNS; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < <<'DOC', 26 | Niko Tyni 27 | DOC 28 | notes => <<'DOC', 29 | The I, I and I EchoPing variables are not valid. 30 | 31 | Plugins, including echoping_dns, are available starting with echoping version 6. 32 | DOC 33 | see_also => <, 35 | L 36 | DOC 37 | } 38 | } 39 | 40 | use strict; 41 | use base qw(Smokeping::probes::EchoPingPlugin); 42 | use Carp; 43 | 44 | sub plugin_args { 45 | my $self = shift; 46 | my $target = shift; 47 | my @args = ("-t", $target->{vars}{dns_type}); 48 | my $tcp = $target->{vars}{dns_tcp}; 49 | if ($tcp and $tcp ne "no") { 50 | push @args, "--tcp"; 51 | } 52 | push @args, $target->{vars}{dns_request}; 53 | return @args; 54 | } 55 | 56 | sub ProbeDesc($) { 57 | return "DNS pings using the echoping_dns plugin"; 58 | } 59 | 60 | sub targetvars { 61 | my $class = shift; 62 | my $h = $class->SUPER::targetvars; 63 | delete $h->{udp}; 64 | delete $h->{fill}; 65 | delete $h->{size}; 66 | $h->{_mandatory} = [ grep { $_ ne "plugin" } @{$h->{_mandatory}}]; 67 | $h->{plugin}{_default} = 'dns'; 68 | $h->{plugin}{_example} = '/path/to/dns.so'; 69 | return $class->_makevars($h, { 70 | _mandatory => [ 'dns_request' ], 71 | dns_request => { 72 | _doc => < 'example.org', 76 | }, 77 | dns_type => { 78 | _doc => < 'AAAA', 82 | _default => 'A', 83 | }, 84 | dns_tcp => { 85 | _doc => < 'yes', 90 | }, 91 | }, 92 | ); 93 | } 94 | 95 | 1; 96 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingDiscard.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingDiscard; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < <<'DOC', 26 | Niko Tyni 27 | DOC 28 | see_also => < 30 | DOC 31 | } 32 | } 33 | 34 | use strict; 35 | use base qw(Smokeping::probes::EchoPing); 36 | use Carp; 37 | 38 | sub proto_args { 39 | my $self = shift; 40 | my $target = shift; 41 | my @args = $self->udp_arg; 42 | return ("-d", @args); 43 | } 44 | 45 | sub ProbeDesc($) { 46 | return "TCP or UDP Discard pings using echoping(1)"; 47 | } 48 | 49 | 50 | 1; 51 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingHttp.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingHttp; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::EchoPing); 19 | use Carp; 20 | 21 | sub pod_hash { 22 | return { 23 | name => < < < variable than the 31 | default 20, as repetitive URL fetching may be quite heavy on the server. 32 | 33 | The I, I and I EchoPing variables are not valid for EchoPingHttp. 34 | DOC 35 | authors => <<'DOC', 36 | Niko Tyni 37 | DOC 38 | see_also => <, L 40 | DOC 41 | } 42 | } 43 | 44 | sub _init { 45 | my $self = shift; 46 | # HTTP doesn't fit with filling or size 47 | my $arghashref = $self->features; 48 | delete $arghashref->{size}; 49 | delete $arghashref->{fill}; 50 | } 51 | 52 | # tag the port number after the hostname 53 | sub make_host { 54 | my $self = shift; 55 | my $target = shift; 56 | 57 | my $host = $self->SUPER::make_host($target); 58 | my $port = $target->{vars}{port}; 59 | 60 | $host .= ":$port" if defined $port; 61 | return $host; 62 | } 63 | 64 | sub proto_args { 65 | my $self = shift; 66 | my $target = shift; 67 | my $url = $target->{vars}{url}; 68 | 69 | my @args = ("-h", $url); 70 | 71 | # -A : ignore cache 72 | my $ignore = $target->{vars}{ignore_cache}; 73 | $ignore = 1 74 | if (defined $ignore and $ignore ne "no" 75 | and $ignore ne "0"); 76 | push @args, "-A" if $ignore; 77 | 78 | # -a : force cache to revalidate the data 79 | my $revalidate = $target->{vars}{revalidate_data}; 80 | $revalidate= 1 if (defined $revalidate and $revalidate ne "no" 81 | and $revalidate ne "0"); 82 | push @args, "-a" if $revalidate; 83 | 84 | # -R : accept HTTP redirects 85 | my $accept_redirects = $target->{vars}{accept_redirects}; 86 | $accept_redirects= 1 if (defined $accept_redirects 87 | and $accept_redirects ne "no" 88 | and $accept_redirects ne "0"); 89 | push @args, "-R" if $accept_redirects; 90 | 91 | return @args; 92 | } 93 | 94 | sub ProbeDesc($) { 95 | return "HTTP pings using echoping(1)"; 96 | } 97 | 98 | sub targetvars { 99 | my $class = shift; 100 | my $h = $class->SUPER::targetvars; 101 | delete $h->{udp}; 102 | delete $h->{fill}; 103 | delete $h->{size}; 104 | $h->{timeout}{_default} = 10; 105 | $h->{timeout}{_example} = 20; 106 | return $class->_makevars($h, { 107 | url => { 108 | _doc => < '/', 113 | }, 114 | port => { 115 | _doc => 'The TCP port to use.', 116 | _example => 80, 117 | _re => '\d+', 118 | }, 119 | ignore_cache => { 120 | _doc => < 'yes', 125 | }, 126 | revalidate_data => { 127 | _doc => < 'no', 132 | }, 133 | accept_redirects => { 134 | _doc => < 'yes', 142 | }, 143 | }); 144 | } 145 | 146 | 1; 147 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingHttps.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingHttps; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::EchoPingHttp); 19 | use Carp; 20 | 21 | sub pod_hash { 22 | return { 23 | name => < < < < variable than the 35 | default 20, as repetitive URL fetching may be quite heavy on the server. 36 | DOC 37 | authors => <<'DOC', 38 | Niko Tyni 39 | DOC 40 | see_also => < 42 | DOC 43 | } 44 | } 45 | 46 | sub proto_args { 47 | my $self = shift; 48 | my $target = shift; 49 | my @args = $self->SUPER::proto_args($target); 50 | return ("-C", @args); 51 | } 52 | 53 | sub ProbeDesc($) { 54 | return "HTTPS pings using echoping(1)"; 55 | } 56 | 57 | 58 | sub targetvars { 59 | my $class = shift; 60 | my $h = $class->SUPER::targetvars; 61 | $h->{prot}{_example} = 3443; 62 | $h->{prot}{_default} = 443; 63 | return $h; 64 | } 65 | 66 | 1; 67 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingIcp.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingIcp; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::EchoPing); 19 | use Carp; 20 | 21 | sub pod_hash { 22 | return { 23 | name => < < <, I and I EchoPing variables are not valid. 32 | DOC 33 | authors => <<'DOC', 34 | Niko Tyni 35 | DOC 36 | see_also => <, L 38 | DOC 39 | } 40 | } 41 | 42 | sub _init { 43 | my $self = shift; 44 | # Icp doesn't fit with filling or size 45 | my $arghashref = $self->features; 46 | delete $arghashref->{size}; 47 | delete $arghashref->{fill}; 48 | } 49 | 50 | sub proto_args { 51 | my $self = shift; 52 | my $target = shift; 53 | my $url = $target->{vars}{url}; 54 | 55 | my @args = ("-i", $url); 56 | 57 | return @args; 58 | } 59 | 60 | sub ProbeDesc($) { 61 | return "ICP pings using echoping(1)"; 62 | } 63 | 64 | sub targetvars { 65 | my $class = shift; 66 | my $h = $class->SUPER::targetvars; 67 | delete $h->{udp}; 68 | delete $h->{fill}; 69 | delete $h->{size}; 70 | return $class->_makevars($h, { 71 | _mandatory => [ 'url' ], 72 | url => { 73 | _doc => "The URL to be requested from the web cache.", 74 | _example => 'http://www.example.org/', 75 | }, 76 | }); 77 | } 78 | 79 | 1; 80 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingLDAP.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingLDAP; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < <<'DOC', 26 | Niko Tyni 27 | DOC 28 | notes => <<'DOC', 29 | The I, I and I EchoPing variables are not valid. 30 | 31 | Plugins, including echoping_ldap, are available starting with echoping version 6. 32 | DOC 33 | see_also => <, 35 | L 36 | DOC 37 | } 38 | } 39 | 40 | use strict; 41 | use base qw(Smokeping::probes::EchoPingPlugin); 42 | use Carp; 43 | 44 | sub plugin_args { 45 | my $self = shift; 46 | my $target = shift; 47 | my @args; 48 | my $req = $target->{vars}{ldap_request}; 49 | push @args, "-r $req" if $req; 50 | 51 | my $base = $target->{vars}{ldap_base}; 52 | push @args, "-b $base" if $base; 53 | 54 | my $scope = $target->{vars}{ldap_scope}; 55 | push @args, "-s $scope" if $scope; 56 | 57 | return @args; 58 | } 59 | 60 | sub ProbeDesc($) { 61 | return "LDAP pings using the echoping_ldap plugin"; 62 | } 63 | 64 | sub targetvars { 65 | my $class = shift; 66 | my $h = $class->SUPER::targetvars; 67 | delete $h->{udp}; 68 | delete $h->{fill}; 69 | delete $h->{size}; 70 | $h->{_mandatory} = [ grep { $_ ne "plugin" } @{$h->{_mandatory}}]; 71 | $h->{plugin}{_default} = 'ldap'; 72 | $h->{plugin}{_example} = '/path/to/ldap.so'; 73 | return $class->_makevars($h, { 74 | ldap_request => { 75 | _doc => < '(objectclass=*)', 80 | }, 81 | ldap_base => { 82 | _doc => < 'dc=current,dc=bugs,dc=debian,dc=org', 87 | }, 88 | ldap_scope => { 89 | _doc => < 'one', 94 | }, 95 | }, 96 | ); 97 | } 98 | 99 | 1; 100 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingPlugin.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingPlugin; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < <<'DOC', 28 | Niko Tyni 29 | DOC 30 | notes => <<'DOC', 31 | The I, I and I EchoPing variables are not valid by default for EchoPingPlugin -derived probes. 32 | 33 | Plugins are available starting with echoping version 6. 34 | DOC 35 | see_also => <, 37 | L, 38 | L, 39 | L 40 | DOC 41 | } 42 | } 43 | 44 | use strict; 45 | use base qw(Smokeping::probes::EchoPing); 46 | use Carp; 47 | 48 | sub _init { 49 | my $self = shift; 50 | # plugins don't generally fit with filling, size or udp. 51 | my $arghashref = $self->features; 52 | delete $arghashref->{size}; 53 | delete $arghashref->{fill}; 54 | delete $arghashref->{udp}; 55 | } 56 | 57 | sub post_args { 58 | my $self = shift; 59 | my $target = shift; 60 | return $self->plugin_args($target); 61 | } 62 | 63 | # derived classes should override this 64 | sub plugin_args { 65 | my $self = shift; 66 | my $target = shift; 67 | return (); 68 | } 69 | 70 | sub proto_args { 71 | my $self = shift; 72 | my $target = shift; 73 | my $plugin = $target->{vars}{plugin}; 74 | return ("-m", $plugin); 75 | } 76 | 77 | sub ProbeDesc($) { 78 | return "Pings using an echoping(1) plugin"; 79 | } 80 | 81 | sub targetvars { 82 | my $class = shift; 83 | my $h = $class->SUPER::targetvars; 84 | delete $h->{udp}; 85 | delete $h->{fill}; 86 | delete $h->{size}; 87 | return $class->_makevars($h, { 88 | _mandatory => [ 'plugin' ], 89 | plugin => { 90 | _doc => < "random", 96 | }, 97 | pluginargs => { 98 | _doc => < variable. These are generally provided by the subclass probe. 101 | DOC 102 | _example => "-p plugin_specific_arg", 103 | }, 104 | }, 105 | ); 106 | } 107 | 108 | 1; 109 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingSmtp.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingSmtp; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::EchoPing); 19 | use Carp; 20 | 21 | sub pod_hash { 22 | return { 23 | name => < < <, I and I EchoPing variables are not valid. 31 | DOC 32 | authors => <<'DOC', 33 | Niko Tyni 34 | DOC 35 | see_also => < 37 | DOC 38 | } 39 | } 40 | 41 | sub _init { 42 | my $self = shift; 43 | # SMTP doesn't fit with filling or size 44 | my $arghashref = $self->features; 45 | delete $arghashref->{size}; 46 | delete $arghashref->{fill}; 47 | } 48 | 49 | sub proto_args { 50 | return ("-S"); 51 | } 52 | 53 | sub ProbeDesc($) { 54 | return "SMTP pings using echoping(1)"; 55 | } 56 | 57 | sub targetvars { 58 | my $class = shift; 59 | my $h = $class->SUPER::targetvars; 60 | delete $h->{udp}; 61 | delete $h->{fill}; 62 | delete $h->{size}; 63 | return $h; 64 | } 65 | 66 | 1; 67 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/EchoPingWhois.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::EchoPingWhois; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < <<'DOC', 26 | Niko Tyni 27 | DOC 28 | notes => <<'DOC', 29 | The I, I and I EchoPing variables are not valid. 30 | 31 | Plugins, including echoping_whois, are available starting with echoping version 6. 32 | DOC 33 | see_also => <, 35 | L 36 | DOC 37 | } 38 | } 39 | 40 | use strict; 41 | use base qw(Smokeping::probes::EchoPingPlugin); 42 | use Carp; 43 | 44 | sub plugin_args { 45 | my $self = shift; 46 | my $target = shift; 47 | my @args; 48 | push @args, $target->{vars}{whois_request}; 49 | 50 | return @args; 51 | } 52 | 53 | sub ProbeDesc($) { 54 | return "whois pings using the echoping_whois plugin"; 55 | } 56 | 57 | sub targetvars { 58 | my $class = shift; 59 | my $h = $class->SUPER::targetvars; 60 | delete $h->{udp}; 61 | delete $h->{fill}; 62 | delete $h->{size}; 63 | $h->{_mandatory} = [ grep { $_ ne "plugin" } @{$h->{_mandatory}}]; 64 | $h->{plugin}{_default} = 'whois'; 65 | $h->{plugin}{_example} = '/path/to/whois.so'; 66 | return $class->_makevars($h, { 67 | _mandatory => [ 'whois_request' ], 68 | whois_request => { 69 | _doc => < 'example.org', 73 | }, 74 | }, 75 | ); 76 | } 77 | 78 | 1; 79 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/FPing6.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::FPing6; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::FPing); 19 | 20 | sub pod_hash { 21 | return { 22 | name => < < <<'DOC', 31 | Tobias Oetiker 32 | 33 | Niko Tyni 34 | DOC 35 | see_also => < 37 | DOC 38 | } 39 | } 40 | 41 | sub testhost { 42 | return "::1"; 43 | } 44 | 45 | sub probevars { 46 | my $self = shift; 47 | my $h = $self->SUPER::probevars; 48 | $h->{binary}{_example} = "/usr/bin/fping6"; 49 | $h->{protocol}{_example} = "6"; 50 | $h->{protocol}{_default} = "6"; 51 | $h->{sourceaddress}{_re} = "[0-9A-Fa-f:.]+"; 52 | $h->{sourceaddress}{_example} = "::1"; 53 | return $h; 54 | } 55 | 56 | sub ProbeDesc($){ 57 | my $self = shift; 58 | my $bytes = $self->{properties}{packetsize}||56; 59 | return "IPv6-ICMP Echo Pings ($bytes Bytes)"; 60 | } 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/Qstat.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::Qstat; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use IPC::Open3; 20 | use Symbol; 21 | use Carp; 22 | use Time::HiRes qw(usleep); 23 | 24 | sub pod_hash { 25 | return { 26 | name => < < must 31 | point to your copy of the Qstat program. 32 | 33 | Make sure to set your pings to 10, most Quake servers seem to throttle 34 | after 10 rapid pings. 35 | 36 | Set the game parameter to one of the valid options to check a different type 37 | DOC 38 | authors => <<'DOC', 39 | Walter Huf 40 | DOC 41 | } 42 | } 43 | 44 | sub new($$$) 45 | { 46 | my $proto = shift; 47 | my $class = ref($proto) || $proto; 48 | my $self = $class->SUPER::new(@_); 49 | 50 | # no need for this if we run as a cgi 51 | unless ( $ENV{SERVER_SOFTWARE} ) { 52 | my $binary = join(" ", $self->binary); 53 | my $return = `$binary 2>&1`; 54 | $self->{enable}{S} = (`$binary 2>&1` =~ /\s-S\s/); 55 | croak "ERROR: Qstat ('$binary') could not be run: $return" 56 | if $return =~ m/not found/; 57 | }; 58 | 59 | return $self; 60 | } 61 | 62 | sub ProbeDesc($){ 63 | my $self = shift; 64 | my $game = $self->{properties}{game}||'q3s'; 65 | return "Game server $game pings"; 66 | } 67 | 68 | # derived class can override this 69 | sub binary { 70 | my $self = shift; 71 | return $self->{properties}{binary}; 72 | } 73 | 74 | sub pingone($$) { 75 | my $self = shift; 76 | my $address = shift; 77 | 78 | my @times; 79 | for (my $count = 0; $count < $self->pings($address); $count++) { 80 | push @times, $self->pinghost($address); 81 | } 82 | return @times 83 | } 84 | 85 | sub pinghost($$) { 86 | my $self = shift; 87 | my $address = shift; 88 | 89 | my $inh = gensym; 90 | my $outh = gensym; 91 | my $errh = gensym; 92 | my $time; 93 | # pinging nothing is pointless 94 | return unless $address; 95 | $address = $address->{addr}; 96 | my @params = (); 97 | push @params, "-nocfg"; 98 | push @params, "-xml"; 99 | push @params, "-timeout", $self->{properties}{timeout} if $self->{properties}{timeout}; 100 | push @params, "-srcip", $self->{properties}{sourceaddress} if $self->{properties}{sourceaddress}; 101 | push @params, "-srcport", $self->{properties}{sourceport} if $self->{properties}{sourceport}; 102 | push @params, "-" . $self->{properties}{game}; 103 | if ($self->{properties}{port} && $address !~ /:/) { 104 | push @params, $address . ':' . $self->{properties}{port}; 105 | } else { 106 | push @params, $address; 107 | } 108 | 109 | my @cmd = ( 110 | $self->binary, 111 | @params); 112 | $self->do_debug("Executing @cmd"); 113 | my $pid = open3($inh,$outh,$errh, @cmd); 114 | while (<$outh>){ 115 | chomp; 116 | $self->do_debug("Got quakestat output: '$_'"); 117 | next unless /^\s*(\d+)<\/ping>\s*$/; #filter out the ping latency line 118 | $time = $1; 119 | } 120 | waitpid $pid,0; 121 | my $rc = $?; 122 | carp join(" ",@cmd) . " returned with exit code $rc. run with debug enabled to get more information" unless $rc == 0; 123 | close $inh; 124 | close $outh; 125 | close $errh; 126 | return $time/1000.0 if defined($time); 127 | return; 128 | } 129 | 130 | sub probevars { 131 | my $class = shift; 132 | return $class->_makevars($class->SUPER::probevars, { 133 | _mandatory => [ 'binary' ], 134 | binary => { 135 | _sub => sub { 136 | my ($val) = @_; 137 | return undef if $ENV{SERVER_SOFTWARE}; # don't check for qstat presence in cgi mode 138 | return "ERROR: Qstat 'binary' does not point to an executable" 139 | unless -f $val and -x _; 140 | return undef; 141 | }, 142 | _doc => "The location of your quakestat binary.", 143 | _example => '/usr/bin/quakestatba', 144 | }, 145 | game => { 146 | _example => "nexuizs", 147 | _default => "q3s", 148 | _doc => < { 153 | _re => '\d+', 154 | _example => 27970, 155 | _doc => < { 160 | _re => '\d+', 161 | _example => 1, 162 | _doc => < { 167 | _re => '(\d*\.)?\d+', 168 | _example => .1, 169 | _default => .5, 170 | _doc => < { 175 | _re => '\d+(\.\d+){3}', 176 | _example => '192.168.0.1', 177 | _doc => < { 184 | _re => '\d{1,5}(-\d{1,5})?', 185 | _example => '9923-9943', 186 | _sub => sub { 187 | my ($val) = @_; 188 | my @ports = split('-', $val); 189 | if (scalar @ports == 2 and $ports[0] > $ports[1]) { 190 | return "ERROR: Qstat invalid source port range"; 191 | } 192 | return undef; 193 | }, 194 | _doc => < 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | sub pod_hash { 18 | return { 19 | name => < < must point to your copy of the ssh/rsh program. 25 | The variable B must point to your copy of the fping program 26 | at the remote end. 27 | DOC 28 | notes => <<'DOC', 29 | It is important to make sure that you can access the remote machine 30 | without a password prompt, otherwise this probe will not work properly. 31 | To test just try something like this: 32 | 33 | $ ssh foo@HostA.foobar.com fping HostB.barfoo.com 34 | 35 | The next thing you see must be fping's output. 36 | 37 | The B, B, B and B variables used to be configured 38 | in the Targets section of the first target or its parents They were moved 39 | to the Probes section, because the variables aren't really target-specific 40 | (all the targets are measured with the same parameters). The Targets 41 | sections aren't recognized anymore. 42 | DOC 43 | authors => <<'DOC', 44 | Luis F Balbinot 45 | 46 | Niko Tyni 47 | 48 | derived from Smokeping::probes::FPing by 49 | 50 | Tobias Oetiker 51 | DOC 52 | bugs => <SUPER::ProbeDesc; 65 | return "Remote $superdesc"; 66 | } 67 | 68 | sub binary { 69 | my $self = shift; 70 | my @ret = ( $self->SUPER::binary ); 71 | for my $what (qw(ruser rport rhost rbinary)) { 72 | my $prefix = ($what eq 'ruser' ? "-l" : ""); 73 | my $port = ($what eq 'rport' ? "-p" : ""); 74 | if (defined $self->{properties}{$what}) { 75 | push @ret, $prefix . $port . $self->{properties}{$what}; 76 | } 77 | } 78 | return @ret; 79 | } 80 | 81 | sub probevars { 82 | my $class = shift; 83 | my $h = $class->SUPER::probevars; 84 | $h->{rbinary} = $h->{binary}; 85 | delete $h->{binary}; 86 | delete $h->{rbinary}{_sub}; # we can't check the remote program's -x bit 87 | @{$h->{_mandatory}} = map { $_ ne 'binary' ? $_ : 'rbinary' } @{$h->{_mandatory}}; 88 | return $class->_makevars($h, { 89 | _mandatory => [ 'binary', 'rhost' ], 90 | binary => { 91 | _doc => < '/usr/bin/ssh', 100 | _sub => sub { 101 | my $val = shift; 102 | -x $val or return "ERROR: binary '$val' is not executable"; 103 | return undef; 104 | }, 105 | }, 106 | rhost => { 107 | _doc => < option specifies the remote device from where fping will 109 | be launched. 110 | DOC 111 | _example => 'my.pinger.host', 112 | }, 113 | ruser => { 114 | _doc => < option allows you to specify the remote user, 116 | if different from the one running the smokeping daemon. 117 | DOC 118 | _example => 'foo', 119 | }, 120 | rport => { 121 | _doc => < option allows you to specify the port of the 123 | remote host. 124 | DOC 125 | _example => '22', 126 | }, 127 | }); 128 | } 129 | 130 | 1; 131 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/SSH.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::SSH; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use IPC::Open3; 20 | use Symbol; 21 | use Carp; 22 | use Time::HiRes qw(gettimeofday tv_interval); 23 | 24 | sub pod_hash { 25 | return { 26 | name => < < must 31 | point to your copy of the ssh-keyscan program. If it is not installed on 32 | your system yet, you should install openssh >= 3.8p1 33 | 34 | The Probe asks the given host n-times for it's public key, where n is 35 | the amount specified in the config File. 36 | 37 | As part of the initialization, the probe asks 127.0.0.1 for it's public key 38 | and tries to parse the output. This is to ensure that the specified ssh-keyscan 39 | binary provides output in the expected formatm before relying on it.Make sure 40 | you have SSH running on the localhost as well, or specify an alternative 41 | init_host target to test against, that is expected to be available during any 42 | smokeping restart. 43 | DOC 44 | authors => <<'DOC', 45 | Christian Recktenwald 46 | DOC 47 | } 48 | } 49 | 50 | my $ssh_re=qr/^# \S+ SSH-/i; 51 | 52 | sub new($$$) 53 | { 54 | my $proto = shift; 55 | my $class = ref($proto) || $proto; 56 | my $self = $class->SUPER::new(@_); 57 | 58 | # no need for this if we run as a cgi 59 | unless ( $ENV{SERVER_SOFTWARE} ) { 60 | 61 | my $call = "$self->{properties}{binary} -t dsa,rsa,ecdsa $self->{properties}{init_host}"; 62 | my $return = `$call 2>&1`; 63 | if ($return =~ m/$ssh_re/s){ 64 | print "### parsing ssh-keyscan output...OK\n"; 65 | } else { 66 | croak "ERROR: output of '$call' does not match $ssh_re\n"; 67 | } 68 | }; 69 | 70 | return $self; 71 | } 72 | 73 | sub ProbeDesc($){ 74 | my $self = shift; 75 | return "SSH requests"; 76 | } 77 | 78 | sub pingone ($){ 79 | my $self = shift; 80 | my $target = shift; 81 | 82 | my $inh = gensym; 83 | my $outh = gensym; 84 | my $errh = gensym; 85 | 86 | my $host = $target->{addr}; 87 | 88 | my $query = "$self->{properties}{binary} -t $target->{vars}->{keytype} -p $target->{vars}->{port}"; 89 | my @times; 90 | 91 | # if ipv4/ipv6 proto was specified in the target, add it unless it is "0" 92 | if ($target->{vars}->{ssh_af} && $target->{vars}->{ssh_af} ne "0") { 93 | $query .= " -$target->{vars}->{ssh_af}"; 94 | } 95 | $query .= " $host"; 96 | # get the user and system times before and after the test 97 | $self->do_debug("query=$query\n"); 98 | for (my $run = 0; $run < $self->pings; $run++) { 99 | my $t0 = [gettimeofday()]; 100 | 101 | my $pid = open3($inh,$outh,$errh, $query); 102 | # OpenSSH 9.8 compatibility - output is on stdout now 103 | while (<$outh>) { 104 | if (/$ssh_re/i) { 105 | push @times, tv_interval($t0); 106 | last; 107 | } 108 | } 109 | while (<$errh>) { 110 | if (/$ssh_re/i) { 111 | push @times, tv_interval($t0); 112 | last; 113 | } 114 | } 115 | waitpid $pid,0; 116 | my $rc = $?; 117 | carp "$query returned with exit code $rc. run with debug enabled to get more information" unless $rc == 0; 118 | close $errh; 119 | close $inh; 120 | close $outh; 121 | 122 | } 123 | @times = map {sprintf "%.10e", $_ } sort {$a <=> $b} @times; 124 | 125 | # $self->do_debug("time=@times\n"); 126 | return @times; 127 | } 128 | 129 | sub probevars { 130 | my $class = shift; 131 | return $class->_makevars($class->SUPER::probevars, { 132 | _mandatory => [ 'binary' ], 133 | binary => { 134 | _doc => "The location of your ssh-keyscan binary.", 135 | _example => '/usr/bin/ssh-keyscan', 136 | _sub => sub { 137 | my $val = shift; 138 | -x $val or return "ERROR: binary '$val' is not executable"; 139 | return undef; 140 | }, 141 | }, 142 | init_host => { 143 | _doc => "Host to use for initialization, defaults to IPv4 localhost of 127.0.0.1", 144 | _example => '127.0.0.1', 145 | _default => '127.0.0.1', 146 | } 147 | }) 148 | } 149 | 150 | sub targetvars { 151 | my $class = shift; 152 | return $class->_makevars($class->SUPER::targetvars, { 153 | keytype => { 154 | _doc => "Type of key, used in ssh-keyscan -t I", 155 | _re => "[ecdr]sa*", 156 | _example => 'dsa', 157 | _default => 'rsa', 158 | }, 159 | port => { 160 | _doc => "Port to use when testing the ssh connection -p I", 161 | _re => '\d+', 162 | _example => '5000', 163 | _default => '22', 164 | }, 165 | ssh_af => { 166 | _doc => "Address family (IPv4/IPV6) to use when testing the ssh connection, specify 4 or 6. Specify 0 to reset to default system preference, instead of inheriting the value from parent sections.", 167 | _re => '\d+', 168 | _example => '4', 169 | _default => '0', 170 | }, 171 | }) 172 | } 173 | 1; 174 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/SendEmail.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::SendEmail; 2 | 3 | # Copyright (c) 2012 Florian Coulmier 4 | # 5 | # This program is free software: you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation, either version 3 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public License 16 | # along with this program. If not, see . 1 17 | # 18 | 19 | =head1 301 Moved Permanently 20 | 21 | This is a Smokeping probe module. Please use the command 22 | 23 | C 24 | 25 | to view the documentation or the command 26 | 27 | C 28 | 29 | to generate the POD document. 30 | 31 | =cut 32 | 33 | use strict; 34 | use base qw(Smokeping::probes::basefork); 35 | use Carp; 36 | use Sys::Hostname; 37 | use Time::HiRes; 38 | use Net::SMTP; 39 | 40 | sub pod_hash { 41 | return { 42 | name => < < <<'DOC', 49 | Florian Coulmier , 50 | DOC 51 | see_also => < 53 | DOC 54 | }; 55 | } 56 | 57 | sub new($$$) 58 | { 59 | my $proto = shift; 60 | my $class = ref($proto) || $proto; 61 | my $self = $class->SUPER::new(@_); 62 | 63 | # no need for this if we run as a cgi 64 | unless ( $ENV{SERVER_SOFTWARE} ) { 65 | # if you have to test the program output 66 | # or something like that, do it here 67 | # and bail out if necessary 68 | }; 69 | 70 | return $self; 71 | } 72 | 73 | # Probe-specific variables declaration 74 | sub probevars { 75 | my $class = shift; 76 | return $class->_makevars($class->SUPER::probevars, { 77 | _mandatory => [ 'from', 'to' ], 78 | from => { 79 | _doc => "Mail from address", 80 | _example => 'test@test.com', 81 | }, 82 | to => { 83 | _doc => "Rcpt to address", 84 | _example => 'test@test.com', 85 | }, 86 | subject => { 87 | _doc => "Subject of the mail", 88 | _example => "Test Smokeping", 89 | _default => "Test", 90 | }, 91 | bodysize => { 92 | _doc => "Size of the mail to send in bytes. If set to 0, a default mail content will be set. Note that mail always contain From, To and Subject headers.", 93 | _example => "1024", 94 | _default => "0", 95 | } 96 | }); 97 | } 98 | 99 | # Target-specific variables declaration 100 | sub targetvars { 101 | my $class = shift; 102 | return $class->_makevars($class->SUPER::targetvars, { 103 | port => { _doc => "Port of the SMTP server to reach", 104 | _example => 25, 105 | _default => 25, 106 | }, 107 | }); 108 | } 109 | 110 | sub ProbeDesc($){ 111 | my $self = shift; 112 | return "Measure time to send a complete email"; 113 | } 114 | 115 | # this is where the actual stuff happens 116 | sub pingone ($){ 117 | my $self = shift; 118 | my $target = shift; 119 | 120 | my @times; 121 | 122 | # Retrieve probe-specific and target-specific variables 123 | my $count = $self->pings($target); 124 | my $from = $self->{properties}{from}; 125 | my $to = $self->{properties}{to}; 126 | my $subject = $self->{properties}{subject} || "Smokeping Test"; 127 | my $bodysize = $self->{properties}{bodysize} || 0; 128 | 129 | my $host = $target->{addr}; 130 | my $port = $target->{vars}{port} || 25; 131 | 132 | # Get Hostname 133 | my $hostname = hostname(); 134 | 135 | 136 | # Send a mail as many times as requested 137 | for (1..$count) { 138 | # Start counting time 139 | my $start = Time::HiRes::gettimeofday(); 140 | 141 | # Open the connection and then send the mail 142 | my $smtp = new Net::SMTP("$host:$port", Timeout => 5, Hello => $hostname); 143 | next if (!$smtp); 144 | 145 | $smtp->mail($from) || next; 146 | $smtp->to($to, { Notify => ['NEVER'] }) || next; 147 | $smtp->data() || next; 148 | $smtp->datasend("From: <$from>\n"); 149 | $smtp->datasend("To: <$to>\n"); 150 | $smtp->datasend("Subject: $subject\n"); 151 | $smtp->datasend("\n"); 152 | 153 | # If user specified a bodysize for the probe, send the request number of characters instead of the default content. 154 | if ($bodysize > 0) { 155 | my $nbLines = $bodysize / 80; 156 | for (1..$nbLines) { 157 | $smtp->datasend(sprintf("%s\n", "A" x 79)); 158 | } 159 | $smtp->datasend(sprintf("%s\n", "A" x ($bodysize % 80))); 160 | } else { 161 | $smtp->datasend("This is a test email sent by Smokeping to check speed of mx server $host.\n"); 162 | $smtp->datasend("If you receive this mail in your mailbox, you are likely to be spammed in just few minutes!\n"); 163 | } 164 | 165 | $smtp->dataend() || next; 166 | $smtp->quit(); 167 | 168 | # End measure of time and save it 169 | my $end = Time::HiRes::gettimeofday(); 170 | push(@times, $end - $start); 171 | } 172 | 173 | return sort {$a <=> $b } @times; 174 | } 175 | 176 | # That's all, folks! 177 | 178 | 1; 179 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/SipSak.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::SipSak; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use Carp; 20 | use IO::Select; 21 | 22 | sub pod_hash { 23 | return { 24 | name => < < < tool to measure sip server latency by sending an OPTIONS message. 32 | 33 | The sipsak command supports a large number of additional parameters to fine-tune its operation. Use the 34 | params variable to configure them. 35 | DOC 36 | authors => <<'DOC', 37 | Tobias Oetiker sponsored by ANI Networks 38 | DOC 39 | } 40 | } 41 | 42 | sub ProbeDesc ($) { 43 | my $self = shift; 44 | return sprintf("SIP OPTIONS messages"); 45 | } 46 | 47 | sub new { 48 | my $proto = shift; 49 | my $class = ref($proto) || $proto; 50 | my $self = $class->SUPER::new(@_); 51 | return $self; 52 | } 53 | 54 | sub pingone { 55 | my $self = shift; 56 | my $target = shift; 57 | my $host = $target->{addr}; 58 | my $vars = $target->{vars}; 59 | my @times; 60 | my $elapsed; 61 | my $pingcount = $self->pings($target); 62 | my $keep = $vars->{keep_second}; 63 | $host = $vars->{user}.'@'.$host if $vars->{user}; 64 | $host = $host . ':' . $vars->{port} if $vars->{port}; 65 | my @extra_opts = (); 66 | @extra_opts = split /\s/, $vars->{params} if $vars->{params}; 67 | open (my $sak,'-|',$self->{properties}{binary},'-vv','-A',$pingcount,'-s','sip:'.$host,@extra_opts) 68 | or die("ERROR: $self->{properties}{binary}: $!\n"); 69 | my $sel = IO::Select->new(); 70 | $sel->add($sak); 71 | if (not $sel->can_read($vars->{sipsak_timeout})){ 72 | $self->do_debug("SipSak: timeout for $host"); 73 | return ''; 74 | } 75 | 76 | my $reply = join ("",<$sak>); 77 | close $sak; 78 | 79 | my @reply = split /\*\*\sreply/, $reply; 80 | # don't need the stuff before the first replyx 81 | shift @reply; 82 | 83 | my $filter = '.*'; 84 | $self->do_debug("SipSak: got ".(scalar @reply)." replies, expected $pingcount"); 85 | if (scalar @reply > $pingcount){ 86 | $filter = $keep eq 'yes' ? 'final received' : 'provisional received'; 87 | } 88 | for my $item (@reply){ 89 | $self->do_debug("SipSak: looking at '$item'"); 90 | if (not $item =~ /$filter/){ 91 | $self->do_debug("SipSak: skipping as there was not match for $filter"); 92 | next; 93 | } 94 | if ($item =~ /(?:\sand|\sreceived\safter)\s(\d+(?:\.\d+)?)\sms\s/){ 95 | $self->do_debug("SipSak: match"); 96 | push @times,$1/1000; 97 | } 98 | else { 99 | $self->do_debug("SipSak: no match"); 100 | } 101 | } 102 | return sort { $a <=> $b } @times; 103 | } 104 | 105 | sub probevars { 106 | my $class = shift; 107 | my $h = $class->SUPER::probevars; 108 | return $class->_makevars($h, { 109 | binary => { 110 | _doc => "The location of your echoping binary.", 111 | _default => '/usr/bin/sipsak', 112 | _sub => sub { 113 | my $val = shift; 114 | -x $val or return "ERROR: binary '$val' is not executable"; 115 | return undef; 116 | }, 117 | }, 118 | }); 119 | } 120 | 121 | sub targetvars { 122 | my $class = shift; 123 | return $class->_makevars($class->SUPER::targetvars, { 124 | user => { 125 | _doc => "User to use for sip connection.", 126 | _example => 'nobody', 127 | }, 128 | port => { 129 | _doc => "usa non-default port for the sip connection.", 130 | _example => 5061, 131 | }, 132 | params => { 133 | _doc => "additional sipsak options. The options will get split on space.", 134 | _example => '--numeric --password=mysecret' 135 | }, 136 | keep_second => { 137 | _doc => "If OPTIONS is actually implemented by the server, SipSak will receive two responses. If this option is set, the timing from the second, final response will be counter", 138 | _example => 'yes', 139 | _re => 'yes|no' 140 | }, 141 | sipsak_timeout => { 142 | _doc => "Timeout for sipsak in seconds (fractional)", 143 | _default => 2, 144 | }, 145 | }); 146 | } 147 | 148 | 1; 149 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/TCPPing.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::TCPPing; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use IPC::Open3; 20 | use Symbol; 21 | use Carp; 22 | 23 | sub pod_hash { 24 | return { 25 | name => < < must 30 | point to your copy of the TCPPing program. If it is not installed on 31 | your system yet, you can get it from https://github.com/deajan/tcpping. 32 | 33 | The (optional) port option lets you configure the port for the pings sent. 34 | The TCPPing manpage has the following to say on this topic: 35 | 36 | The problem is that with the widespread use of firewalls on the modern Internet, 37 | many of the packets that traceroute(8) sends out end up being filtered, 38 | making it impossible to completely trace the path to the destination. 39 | However, in many cases, these firewalls will permit inbound TCP packets to specific 40 | ports that hosts sitting behind the firewall are listening for connections on. 41 | By sending out TCP SYN packets instead of UDP or ICMP ECHO packets, 42 | tcptraceroute is able to bypass the most common firewall filters. 43 | 44 | It is worth noting that tcptraceroute never completely establishes a TCP connection 45 | with the destination host. If the host is not listening for incoming connections, 46 | it will respond with an RST indicating that the port is closed. If the host instead 47 | responds with a SYN|ACK, the port is known to be open, and an RST is sent by 48 | the kernel tcptraceroute is running on to tear down the connection without completing 49 | three-way handshake. This is the same half-open scanning technique that nmap(1) uses 50 | when passed the -sS flag. 51 | DOC 52 | authors => <<'DOC', 53 | Norman Rasmussen 54 | Patched for Smokeping 2.x compatibility by Anton Chernev 55 | DOC 56 | } 57 | } 58 | 59 | 60 | sub new($$$) 61 | { 62 | my $proto = shift; 63 | my $class = ref($proto) || $proto; 64 | my $self = $class->SUPER::new(@_); 65 | 66 | # no need for this if we run as a cgi 67 | unless ( $ENV{SERVER_SOFTWARE} ) { 68 | my $return = `$self->{properties}{binary} -C -x 1 localhost 2>&1`; 69 | if ($return =~ m/bytes, ([0-9.]+)\sms\s+.*\n.*\n.*:\s+([0-9.]+)/ and $1 > 0){ 70 | $self->{pingfactor} = 1000 * $2/$1; 71 | print "### tcpping seems to report in ", $1/$2, " milliseconds\n"; 72 | } else { 73 | $self->{pingfactor} = 1000; # Gives us a good-guess default 74 | print "### assuming you are using an tcpping copy reporting in milliseconds\n"; 75 | } 76 | }; 77 | 78 | return $self; 79 | } 80 | 81 | sub ProbeDesc($){ 82 | my $self = shift; 83 | return "TCP Pings"; 84 | } 85 | 86 | sub probevars { 87 | my $class = shift; 88 | return $class->_makevars($class->SUPER::probevars, { 89 | _mandatory => [ 'binary' ], 90 | binary => { 91 | _doc => "The location of your tcpping script.", 92 | _example => '/usr/bin/tcpping', 93 | _sub => sub { 94 | my $val = shift; 95 | 96 | return "ERROR: TCPPing 'binary' does not point to an executable" 97 | unless -f $val and -x _; 98 | 99 | my $return = `$val -C -x 1 localhost 2>&1`; 100 | return "ERROR: tcpping must be installed setuid root or it will not work\n" 101 | if $return =~ m/only.+root/; 102 | 103 | return undef; 104 | }, 105 | }, 106 | }); 107 | } 108 | 109 | sub targetvars { 110 | my $class = shift; 111 | return $class->_makevars($class->SUPER::targetvars, { 112 | port => { 113 | _doc => "The TCP port the probe should measure.", 114 | _example => '80', 115 | _sub => sub { 116 | my $val = shift; 117 | 118 | return "ERROR: TCPPing port must be between 0 and 65535" 119 | if $val and ( $val < 0 or $val > 65535 ); 120 | 121 | return undef; 122 | }, 123 | }, 124 | }); 125 | } 126 | 127 | sub pingone ($){ 128 | my $self = shift; 129 | my $target = shift; 130 | # do NOT call superclass ... the ping method MUST be overridden 131 | my $inh = gensym; 132 | my $outh = gensym; 133 | my $errh = gensym; 134 | 135 | my @times; # Result times 136 | 137 | my @port = () ; 138 | push @port, $target->{vars}{port} if $target->{vars}{port}; 139 | 140 | my @cmd = ( 141 | $self->{properties}{binary}, 142 | '-C', '-x', $self->pings($target) 143 | ); 144 | 145 | push @cmd, $target->{addr}, @port; 146 | 147 | $self->do_debug("Executing @cmd"); 148 | my $pid = open3($inh,$outh,$errh, @cmd); 149 | while (<$outh>){ 150 | chomp; 151 | $self->do_debug("Received: $outh"); 152 | next unless /^\S+\s+:\s+[\d\.]/; #filter out error messages from tcpping 153 | @times = split /\s+/; 154 | my $ip = shift @times; 155 | next unless ':' eq shift @times; #drop the colon 156 | 157 | @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} grep /^\d/, @times; 158 | } 159 | waitpid $pid,0; 160 | my $rc = $?; 161 | carp join(" ",@cmd) . " returned with exit code $rc. run with debug enabled to get more information" unless $rc == 0; 162 | close $inh; 163 | close $outh; 164 | close $errh; 165 | 166 | return @times; 167 | } 168 | 169 | 1; 170 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/WebProxyFilter.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::WebProxyFilter; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | use LWP::UserAgent; 20 | use Time::HiRes qw(gettimeofday sleep); 21 | use Carp; 22 | 23 | my $DEFAULTINTERVAL = 1; 24 | 25 | sub pod_hash { 26 | return { 27 | name => < < < <<'DOC', 50 | Tobias Oetiker sponsored by Virtela 51 | DOC 52 | bugs => <SUPER::new(@_); 68 | return $self; 69 | } 70 | 71 | sub pingone { 72 | my $self = shift; 73 | my $target = shift; 74 | my $host = $target->{addr}; 75 | my $vars = $target->{vars}; 76 | my $mininterval = $self->{properties}{min_interval}; 77 | my @times; 78 | my $elapsed; 79 | my $ua = LWP::UserAgent->new; 80 | $ua->agent($vars->{useragent}); 81 | $ua->timeout($vars->{timeout}); 82 | $ua->max_size($vars->{max_size}); 83 | my @targets = ($host, split /\s*,\s*/, $vars->{more_hosts}); 84 | my $targcount = scalar @targets; 85 | my $pingcount = $self->pings($target); 86 | my $deny_re = $vars->{deny_re}; 87 | if ($targcount > $self->pings($target)) { 88 | $self->do_log("ERROR There are more host addresses ($targcount) than ping slots ($pingcount), either increase the pings or reduce the targets.\n"); 89 | return; 90 | } 91 | 92 | for (1..$pingcount) { 93 | if (defined $elapsed) { 94 | my $timeleft = $mininterval - $elapsed; 95 | sleep $timeleft if $timeleft > 0; 96 | } 97 | my $target = shift @targets; 98 | push @targets,$target; 99 | my $start = gettimeofday(); 100 | my $response = $ua->get("http://$target"); 101 | my $end = gettimeofday(); 102 | if ($response->is_success){ 103 | if ($response->content =~ /$deny_re/ism){ 104 | push @times,($end-$start); 105 | } else { 106 | my $content = substr($response->content,0,80)." ..."; 107 | $content =~ s/[\n\r]/ /g; 108 | $self->do_log("Warning: Problem with target $host: got unexpected content from $target: $content"); 109 | } 110 | } else { 111 | $self->do_log("Warning: Problem with target $host: got this error from $target: ".$response->status_line); 112 | } 113 | } 114 | return sort { $a <=> $b } @times; 115 | } 116 | 117 | sub probevars { 118 | my $class = shift; 119 | my $h = $class->SUPER::probevars; 120 | return $class->_makevars($h, { 121 | _mandatory => ['deny_re'], 122 | min_interval => { 123 | _default => $DEFAULTINTERVAL, 124 | _doc => "The minimum interval between each starting GETs in seconds.", 125 | _re => '(\d*\.)?\d+', 126 | _example => '0.1' 127 | }, 128 | useragent => { 129 | _default => "SmokePing/2.x (WebProxyFilter Probe)", 130 | _doc => "The web browser we claim to be, just in case the FW is interested" 131 | }, 132 | maxsize => { 133 | _default => 2000, 134 | _doc => "How much of the webpage should be retrieved." 135 | }, 136 | 137 | }); 138 | } 139 | 140 | sub targetvars { 141 | my $class = shift; 142 | return $class->_makevars($class->SUPER::targetvars, { 143 | timeout => { 144 | _default => 2, 145 | _doc => "Timeout in seconds for the test complete.", 146 | _re => '\d+', 147 | _example => 2, 148 | }, 149 | deny_re => { 150 | _doc => "Regular expression, matching the 'deny' response from the firewall", 151 | _example => 'Access Prohibited', 152 | }, 153 | more_hosts => { 154 | _doc => < variable. The websites will be tested one after the 157 | other in one round, this means that while normal probes do run the same test 158 | several times in a row, this one will alter the webpage with each round. 159 | The reason for this is, that even though we try to retrieve remote webpages, 160 | the answer will come from the firewall every time, so we kill two birds in 161 | one go. First we test the firewalls latency and second we make sure its 162 | filter works properly. 163 | DOC 164 | _re => '[^\s.]+(?:\.[^\s.]+)*(\s*,[^\s.]+(?:\.[^\s.]+)*)*', 165 | _example => 'www.playboy.com, www.our-competition.com', 166 | }, 167 | 168 | }); 169 | } 170 | 171 | 1; 172 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/basevars.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::basevars; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use Smokeping::probes::base; 19 | use base qw(Smokeping::probes::base); 20 | 21 | my $e = "="; 22 | sub pod_hash { 23 | return { 24 | name => < <, but supports host-specific variables for the probe. 29 | DOC 30 | description => < <<'DOC', 55 | Niko Tyni 56 | DOC 57 | bugs => < <, L 63 | DOC 64 | } 65 | } 66 | 67 | sub add($$) 68 | { 69 | my $self = shift; 70 | my $tree = shift; 71 | 72 | $self->{target_count}++; 73 | $self->{targets}{$tree} = shift; 74 | $self->{vars}{$tree} = { %{$self->{properties}}, %$tree }; 75 | } 76 | 77 | sub targets { 78 | my $self = shift; 79 | my $addr = $self->addresses; 80 | my @targets; 81 | 82 | # copy the addrlookup lists to safely pop 83 | my %copy; 84 | 85 | for (@$addr) { 86 | @{$copy{$_}} = @{$self->{addrlookup}{$_}} unless exists $copy{$_}; 87 | my $tree = pop @{$copy{$_}}; 88 | my $vars = $self->{vars}{$tree}; 89 | next if defined $vars->{nomasterpoll} and $vars->{nomasterpoll} eq "yes"; 90 | push @targets, { addr => $_, vars => $vars, tree => $tree }; 91 | } 92 | return \@targets; 93 | } 94 | 95 | sub vars { 96 | my $self = shift; 97 | my $tree = shift; 98 | return $self->{vars}{$tree}; 99 | } 100 | 101 | sub ProbeDesc { 102 | return "Probe that supports variables and doesn't override the ProbeDesc method"; 103 | } 104 | 105 | return 1; 106 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/passwordchecker.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::passwordchecker; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use Smokeping::probes::basefork; 19 | use base qw(Smokeping::probes::basefork); 20 | use Carp; 21 | 22 | my $e = "="; 23 | sub pod_hash { 24 | return { 25 | name => < < < method, that needs the corresponding 64 | host and username as arguments. 65 | 66 | ${e}head2 Password file format 67 | 68 | The password file format is simply one line for each triplet of host, 69 | username and password, separated from each other by colons (:). 70 | 71 | Comment lines, starting with the `#' sign, are ignored, as well as 72 | empty lines. 73 | DOC 74 | authors => <<'DOC', 75 | Niko Tyni 76 | DOC 77 | 78 | bugs => < <, L, L 84 | DOC 85 | } 86 | } 87 | 88 | sub ProbeDesc { 89 | return "probe that can fork, knows about passwords and doesn't override the ProbeDesc method"; 90 | } 91 | 92 | sub probevars { 93 | my $class = shift; 94 | return $class->_makevars($class->SUPER::probevars, { 95 | passwordfile => { 96 | _doc => "Location of the file containing usernames and passwords.", 97 | _example => '/some/place/secret', 98 | _sub => sub { 99 | my $val = shift; 100 | -r $val or $ENV{SERVER_SOFTWARE} or return "ERROR: password file $val is not readable."; 101 | return undef; 102 | }, 103 | }, 104 | }); 105 | } 106 | 107 | sub new { 108 | my $proto = shift; 109 | my $class = ref($proto) || $proto; 110 | my $self = $class->SUPER::new(@_); 111 | 112 | # no need for this if we run as a cgi 113 | unless ($ENV{SERVER_SOFTWARE}) { 114 | 115 | if (defined $self->{properties}{passwordfile}) { 116 | my @stat = stat($self->{properties}{passwordfile}); 117 | my $mode = $stat[2]; 118 | carp("Warning: password file $self->{properties}{passwordfile} is world-readable\n") 119 | if defined $mode and $mode & 04; 120 | 121 | open(P, "<$self->{properties}{passwordfile}") 122 | or croak("Error opening specified password file $self->{properties}{passwordfile}: $!"); 123 | while (

) { 124 | chomp; 125 | next unless /\S/; 126 | next if /^\s*#/; 127 | my ($host, $username, $password) = split(/:/); 128 | carp("Line $. in $self->{properties}{passwordfile} is invalid"), next unless defined $host and defined $username and defined $password; 129 | $self->password($host, $username, $password); 130 | } 131 | close P; 132 | } 133 | } 134 | 135 | 136 | return $self; 137 | } 138 | 139 | sub password { 140 | my $self = shift; 141 | my $host = shift; 142 | my $username = shift; 143 | my $newval = shift; 144 | $self->{password}{$host}{$username} = $newval if defined $newval; 145 | return $self->{password}{$host}{$username}; 146 | } 147 | 148 | 1; 149 | -------------------------------------------------------------------------------- /lib/Smokeping/probes/skel.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::probes::skel; 2 | 3 | =head1 301 Moved Permanently 4 | 5 | This is a Smokeping probe module. Please use the command 6 | 7 | C 8 | 9 | to view the documentation or the command 10 | 11 | C 12 | 13 | to generate the POD document. 14 | 15 | =cut 16 | 17 | use strict; 18 | use base qw(Smokeping::probes::basefork); 19 | # or, alternatively 20 | # use base qw(Smokeping::probes::base); 21 | use Carp; 22 | 23 | sub pod_hash { 24 | return { 25 | name => < < 31 | document for more information. 32 | DOC 33 | authors => <<'DOC', 34 | Niko Tyni , 35 | DOC 36 | see_also => < 38 | DOC 39 | }; 40 | } 41 | 42 | sub new($$$) 43 | { 44 | my $proto = shift; 45 | my $class = ref($proto) || $proto; 46 | my $self = $class->SUPER::new(@_); 47 | 48 | # no need for this if we run as a cgi 49 | unless ( $ENV{SERVER_SOFTWARE} ) { 50 | # if you have to test the program output 51 | # or something like that, do it here 52 | # and bail out if necessary 53 | }; 54 | 55 | return $self; 56 | } 57 | 58 | # This is where you should declare your probe-specific variables. 59 | # The example shows the common case of checking the availability of 60 | # the specified binary. 61 | 62 | sub probevars { 63 | my $class = shift; 64 | return $class->_makevars($class->SUPER::probevars, { 65 | #_mandatory => [ 'binary' ], 66 | #binary => { 67 | # _doc => "The location of your pingpong binary.", 68 | # _example => '/usr/bin/pingpong', 69 | # _sub => sub { 70 | # my $val = shift; 71 | # return "ERROR: pingpong 'binary' does not point to an executable" 72 | # unless -f $val and -x _; 73 | # return undef; 74 | # }, 75 | #}, 76 | }); 77 | } 78 | 79 | # Here's the place for target-specific variables 80 | 81 | sub targetvars { 82 | my $class = shift; 83 | return $class->_makevars($class->SUPER::targetvars, { 84 | #weight => { _doc => "The weight of the pingpong ball in grams", 85 | # _example => 15 86 | #}, 87 | }); 88 | } 89 | 90 | sub ProbeDesc($){ 91 | my $self = shift; 92 | return "pingpong points"; 93 | } 94 | 95 | # this is where the actual stuff happens 96 | # you can access the probe-specific variables 97 | # via the $self->{properties} hash and the 98 | # target-specific variables via $target->{vars} 99 | 100 | # If you based your class on 'Smokeping::probes::base', 101 | # you'd have to provide a "ping" method instead 102 | # of "pingone" 103 | 104 | sub pingone ($){ 105 | my $self = shift; 106 | my $target = shift; 107 | 108 | # my $binary = $self->{properties}{binary}; 109 | # my $weight = $target->{vars}{weight} 110 | # my $count = $self->pings($target); # the number of pings for this targets 111 | 112 | # ping one target 113 | 114 | # execute a command and parse its output 115 | # you should return a sorted array of the measured latency times 116 | # it could go something like this: 117 | 118 | my @times; 119 | 120 | #for (1..$count) { 121 | # open(P, "$cmd 2>&1 |") or croak("fork: $!"); 122 | # while (

) { 123 | # /time: (\d+\.\d+)/ and push @times, $1; 124 | # } 125 | # close P; 126 | #} 127 | 128 | 129 | return @times; 130 | } 131 | 132 | # That's all, folks! 133 | 134 | 1; 135 | -------------------------------------------------------------------------------- /lib/Smokeping/sorters/Loss.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::sorters::Loss; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::sorters::Loss - Order the target charts by loss 6 | 7 | =head1 OVERVIEW 8 | 9 | Find the charts with the highest loss. 10 | 11 | =head1 DESCRIPTION 12 | 13 | Call the sorter in the charts section of the config file 14 | 15 | + charts 16 | menu = Charts 17 | title = The most interesting destinations 18 | 19 | ++ loss 20 | sorter = Loss(entries=>10) 21 | title = The Losers 22 | menu = Loss 23 | format = Packets Lost %f 24 | 25 | =head1 COPYRIGHT 26 | 27 | Copyright (c) 2007 by OETIKER+PARTNER AG. All rights reserved. 28 | 29 | =head1 LICENSE 30 | 31 | This program is free software; you can redistribute it and/or modify 32 | it under the terms of the GNU General Public License as published by 33 | the Free Software Foundation; either version 2 of the License, or 34 | (at your option) any later version. 35 | 36 | This program is distributed in the hope that it will be useful, 37 | but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | GNU General Public License for more details. 40 | 41 | You should have received a copy of the GNU General Public License 42 | along with this program; if not, write to the Free Software 43 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 44 | 45 | =head1 AUTHOR 46 | 47 | Tobias Oetiker 48 | 49 | =cut 50 | 51 | use strict; 52 | use base qw(Smokeping::sorters::base); 53 | use vars qw($VERSION); 54 | $VERSION = 1.0; 55 | use Carp; 56 | 57 | # how many values does the matcher need to do it's magic 58 | 59 | sub new(@) { 60 | my $class = shift; 61 | my $rules = { 62 | entries => '\d+' 63 | }; 64 | my $self = $class->SUPER::new( $rules, @_ ); 65 | return $self; 66 | } 67 | 68 | sub Desc ($) { 69 | return "The Median sorter sorts the targets by Median RTT."; 70 | } 71 | 72 | sub CalcValue($) { 73 | my $self = shift; 74 | my $info = shift; 75 | # $info = { uptime => w, 76 | # loss => x, 77 | # median => y, 78 | # alert => z, (0/1) 79 | # pings => [qw(a b c d)] 80 | # 81 | return $info->{loss} ? $info->{loss} : -1; 82 | } 83 | -------------------------------------------------------------------------------- /lib/Smokeping/sorters/Max.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::sorters::Max; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::sorters::Max - Order the target charts by Max RTT 6 | 7 | =head1 OVERVIEW 8 | 9 | Find the charts with the highest round trip time. 10 | 11 | =head1 DESCRIPTION 12 | 13 | Call the sorter in the charts section of the config file 14 | 15 | + charts 16 | menu = Charts 17 | title = The most interesting destinations 18 | 19 | ++ max 20 | sorter = Max(entries=>10) 21 | title = Sorted by Max Roundtrip Time 22 | menu = by Max 23 | format = Max Roundtrip Time %f seconds 24 | 25 | =head1 COPYRIGHT 26 | 27 | Copyright (c) 2007 by OETIKER+PARTNER AG. All rights reserved. 28 | 29 | =head1 LICENSE 30 | 31 | This program is free software; you can redistribute it and/or modify 32 | it under the terms of the GNU General Public License as published by 33 | the Free Software Foundation; either version 2 of the License, or 34 | (at your option) any later version. 35 | 36 | This program is distributed in the hope that it will be useful, 37 | but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | GNU General Public License for more details. 40 | 41 | You should have received a copy of the GNU General Public License 42 | along with this program; if not, write to the Free Software 43 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 44 | 45 | =head1 AUTHOR 46 | 47 | Tobias Oetiker 48 | 49 | =cut 50 | 51 | use strict; 52 | use base qw(Smokeping::sorters::base); 53 | use vars qw($VERSION); 54 | $VERSION = 1.0; 55 | use Carp; 56 | 57 | sub new(@) { 58 | my $class = shift; 59 | my $rules = { 60 | entries => '\d+' 61 | }; 62 | my $self = $class->SUPER::new( $rules, @_ ); 63 | return $self; 64 | } 65 | 66 | sub Desc ($) { 67 | return "The Max sorter sorts the targets by Max RTT."; 68 | } 69 | 70 | sub CalcValue($) { 71 | my $self = shift; 72 | my $info = shift; 73 | # $info = { uptime => w, 74 | # loss => x, 75 | # median => y, 76 | # alert => z, (0/1) 77 | # pings => [qw(a b c d)] 78 | # 79 | my $max = (sort { $b <=> $a } grep { defined $_ } @{$info->{pings}})[0]; 80 | return $max ? $max : -1; 81 | } 82 | -------------------------------------------------------------------------------- /lib/Smokeping/sorters/Median.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::sorters::Median; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::sorters::Median - Order the target charts by Median RTT 6 | 7 | =head1 OVERVIEW 8 | 9 | Find the charts with the highest Median round trip time. 10 | 11 | =head1 DESCRIPTION 12 | 13 | Call the sorter in the charts section of the config file 14 | 15 | + charts 16 | menu = Charts 17 | title = The most interesting destinations 18 | 19 | ++ median 20 | sorter = Median(entries=>10) 21 | title = Top Median round trip time 22 | menu = Median RTT 23 | format = Median round trip time %f seconds 24 | 25 | 26 | =head1 COPYRIGHT 27 | 28 | Copyright (c) 2007 by OETIKER+PARTNER AG. All rights reserved. 29 | 30 | =head1 LICENSE 31 | 32 | This program is free software; you can redistribute it and/or modify 33 | it under the terms of the GNU General Public License as published by 34 | the Free Software Foundation; either version 2 of the License, or 35 | (at your option) any later version. 36 | 37 | This program is distributed in the hope that it will be useful, 38 | but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | GNU General Public License for more details. 41 | 42 | You should have received a copy of the GNU General Public License 43 | along with this program; if not, write to the Free Software 44 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 45 | 46 | =head1 AUTHOR 47 | 48 | Tobias Oetiker 49 | 50 | =cut 51 | 52 | use strict; 53 | use base qw(Smokeping::sorters::base); 54 | use vars qw($VERSION); 55 | $VERSION = 1.0; 56 | use Carp; 57 | 58 | # how many values does the matcher need to do it's magic 59 | 60 | sub new(@) { 61 | my $class = shift; 62 | my $rules = { 63 | entries => '\d+' 64 | }; 65 | my $self = $class->SUPER::new( $rules, @_ ); 66 | return $self; 67 | } 68 | 69 | sub Desc ($) { 70 | return "The Median sorter sorts the targets by Median RTT."; 71 | } 72 | 73 | sub CalcValue($) { 74 | my $self = shift; 75 | my $info = shift; 76 | # $info = { uptime => w, 77 | # loss => x, 78 | # median => y, 79 | # alert => z, (0/1) 80 | # pings => [qw(a b c d)] 81 | # 82 | return $info->{median} ? $info->{median} : -1; 83 | } 84 | -------------------------------------------------------------------------------- /lib/Smokeping/sorters/StdDev.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::sorters::StdDev; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::sorters::StdDev - Order the target charts by StdDev 6 | 7 | =head1 OVERVIEW 8 | 9 | Find the charts with the highest standard deviation among the Pings sent to 10 | a single target. The more smoke - higher the standard deviation. 11 | 12 | =head1 DESCRIPTION 13 | 14 | Call the sorter in the charts section of the config file 15 | 16 | + charts 17 | menu = Charts 18 | title = The most interesting destinations 19 | 20 | ++ stddev 21 | sorter = StdDev(entries=>4) 22 | title = Top StdDev 23 | menu = Std Deviation 24 | format = Standard Deviation %f 25 | 26 | =head1 COPYRIGHT 27 | 28 | Copyright (c) 2007 by OETIKER+PARTNER AG. All rights reserved. 29 | 30 | =head1 LICENSE 31 | 32 | This program is free software; you can redistribute it and/or modify 33 | it under the terms of the GNU General Public License as published by 34 | the Free Software Foundation; either version 2 of the License, or 35 | (at your option) any later version. 36 | 37 | This program is distributed in the hope that it will be useful, 38 | but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | GNU General Public License for more details. 41 | 42 | You should have received a copy of the GNU General Public License 43 | along with this program; if not, write to the Free Software 44 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 45 | 46 | =head1 AUTHOR 47 | 48 | Tobias Oetiker 49 | 50 | =cut 51 | 52 | use strict; 53 | use base qw(Smokeping::sorters::base); 54 | use vars qw($VERSION); 55 | $VERSION = 1.0; 56 | use Carp; 57 | 58 | # how many values does the matcher need to do it's magic 59 | 60 | sub new(@) { 61 | my $class = shift; 62 | my $rules = { 63 | entries => '\d+' 64 | }; 65 | my $self = $class->SUPER::new( $rules, @_ ); 66 | return $self; 67 | } 68 | 69 | sub Desc ($) { 70 | return "The Standard Deviation sorter sorts the targets by Standard Deviation."; 71 | } 72 | 73 | sub CalcValue($) { 74 | my $self = shift; 75 | my $info = shift; 76 | # $info = { uptime => w, 77 | # loss => x, 78 | # median => y, 79 | # alert => z, (0/1) 80 | # pings => [qw(a b c d)] 81 | # 82 | my $avg = 0; 83 | my $cnt = 0; 84 | my @values = grep { defined $_ } @{$info->{pings}}; 85 | for (@values){ $avg += $_; $cnt++}; 86 | return -1 if $cnt == 0; 87 | $avg = $avg / $cnt; 88 | my $dev = 0; 89 | for (@values){ $dev += ($_ - $avg)**2}; 90 | $dev = sqrt($dev / $cnt); 91 | return $dev; 92 | } 93 | -------------------------------------------------------------------------------- /lib/Smokeping/sorters/base.pm: -------------------------------------------------------------------------------- 1 | package Smokeping::sorters::base; 2 | 3 | =head1 NAME 4 | 5 | Smokeping::sorters::base - Base Class for implementing SmokePing Sorters 6 | 7 | =head1 OVERVIEW 8 | 9 | Sorters are at the core of the SmokePing Charts feature, where the most 10 | interesting graphs are presented on a single page. The Sorter decides which 11 | graphs are considered interesting. 12 | 13 | Every sorter must inherit from the base class and provide it's own 14 | methods for the 'business' logic. 15 | 16 | In order to maintain a decent performance the sorters activity is split into 17 | two parts. 18 | 19 | The first part is active while the smokeping daemon gathers its data. 20 | Whenever data is received, the sorter is called to calculate a 'value' for 21 | the present data. On every 'query round' this information is stored in the 22 | sorter store directory. Each smokeping process stores it's own information. 23 | Since smokeping can run in multiple instances at the same time, the data may 24 | be split over several files 25 | 26 | The second part of the sorter is called from smokeping.cgi. It loads all the 27 | information from the sorter store and integrates it into a single 'tree'. It 28 | then calls each sorter with the pre-calculated data to get it sorted and to 29 | and to select the interesting information. 30 | 31 | =head1 DESCRIPTION 32 | 33 | Every sorter must provide the following methods: 34 | 35 | =cut 36 | 37 | use vars qw($VERSION); 38 | use Carp; 39 | 40 | $VERSION = 1.0; 41 | 42 | use strict; 43 | 44 | =head2 new 45 | 46 | The new method expects hash elements as an argument 47 | eg new({x=>'\d+',y=>'\d+'},x=>1,y=>2). The first part is 48 | a syntax rule for the arguments it should expect and the second part 49 | are the arguments itself. The first part will be supplied 50 | by the child class as it calls the parent method. 51 | 52 | =cut 53 | 54 | sub new(@) 55 | { 56 | my $this = shift; 57 | my $class = ref($this) || $this; 58 | my $rules = shift; 59 | my $self = { param => { @_ } }; 60 | foreach my $key (keys %{$self->{param}}){ 61 | my $regex = $rules->{$key}; 62 | croak "key '$key' is not known by this sorter" unless defined $rules->{$key}; 63 | croak "key '$key' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/; 64 | } 65 | bless $self, $class; 66 | return $self; 67 | } 68 | 69 | =head2 Desc 70 | 71 | Simply return the description of the function. This method must 72 | be overwritten by a children of the base class. 73 | 74 | =cut 75 | 76 | sub Desc ($) { 77 | croak "Sorter::Desc must be overridden by the subclass"; 78 | } 79 | 80 | =head2 SortTree 81 | 82 | Returns an array of 'targets'. It is up to the sorter to decide how many 83 | entries the list should contain. If the list is empty, the whole entry will 84 | be suppressed in the webfrontend. 85 | 86 | The method gets access to all the targets in the system, together with the 87 | last data set acquired for each target. 88 | 89 | =cut 90 | 91 | sub SortTree($$) { 92 | my $self = shift; 93 | my $target = shift @{$self->{targets}}; 94 | my $cache = shift; 95 | my $entries = $self->{param}{entries} || 3; 96 | my $sorted = [ 97 | map { $entries-- > 0 ? { open => [ split '/', $_ ], value => $cache->{$_} } : () } 98 | sort { $cache->{$b} <=> $cache->{$a} } keys %$cache ]; 99 | return $sorted; 100 | } 101 | 102 | =head2 CalcValues 103 | 104 | Figure out the current sorting value using te following input. 105 | 106 | $info = { uptime => w, 107 | loss => x, 108 | median => y, 109 | alert => z, # (0/1) 110 | pings => [qw(a b c d)] } 111 | 112 | The output can have any structure you want. It will be returned to the 113 | sorter method for further processing. 114 | 115 | =cut 116 | 117 | sub CalcValue($) { 118 | my $self = shift; 119 | my $info = shift; 120 | croak "CalcValue must be overridden by the subclass"; 121 | return ( { any=>'structure' } ); 122 | } 123 | 124 | 125 | =head1 COPYRIGHT 126 | 127 | Copyright (c) 2007 by OETIKER+PARTNER AG. All rights reserved. 128 | 129 | =head1 LICENSE 130 | 131 | This program is free software; you can redistribute it and/or modify 132 | it under the terms of the GNU General Public License as published by 133 | the Free Software Foundation; either version 2 of the License, or 134 | (at your option) any later version. 135 | 136 | This program is distributed in the hope that it will be useful, 137 | but WITHOUT ANY WARRANTY; without even the implied warranty of 138 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 139 | GNU General Public License for more details. 140 | 141 | You should have received a copy of the GNU General Public License 142 | along with this program; if not, write to the Free Software 143 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 144 | 145 | =head1 AUTHOR 146 | 147 | Tobias Oetiker 148 | 149 | =cut 150 | -------------------------------------------------------------------------------- /thirdparty/Makefile.am: -------------------------------------------------------------------------------- 1 | # Copyright (C) 2019 Tobias Oetiker 2 | 3 | AUTOMAKE_OPTIONS = foreign 4 | export PATH := /usr/gnu/bin:$(PATH) 5 | 6 | THIRDPARTY_DIR := $(shell pwd) 7 | 8 | # THIRDPARTY_DIST := $(shell test -d cache && find cache -type f ) 9 | CPANSNAPV := cpanfile-$(shell $(PERL) -MConfig -e 'my $$v =$$Config{version}; $$v =~ s/.\d+$$//;print $$v;').snapshot 10 | 11 | #EXTRA_DIST = $(THIRDPARTY_DIST) $(wildcard bin/cpanm) 12 | EXTRA_DIST = bin/cpanm $(wildcard cpanfile*snapshot) 13 | PERL_ENV := PERL_CPANM_OPT= PERL_CPANM_HOME=$(THIRDPARTY_DIR) PERL_CARTON_PATH=$(THIRDPARTY_DIR) 14 | 15 | all-local: touch 16 | 17 | touch: bin/cpanm $(CPANSNAPV) 18 | $(AM_V_at)echo "** Installing Dependencies using cpanm and $(CPANSNAPV)" 19 | $(AM_V_at)cp $(CPANSNAPV) ../cpanfile.snapshot 20 | $(PERL_ENV) $(PERL) bin/cpanm -q --notest --local-lib-contained $(THIRDPARTY_DIR) --installdeps .. 21 | $(AM_V_at)rm -f ../cpanfile.snapshot 22 | $(AM_V_at)touch touch 23 | 24 | bin/cpanm: 25 | $(AM_V_at)mkdir -p bin 26 | $(URL_CAT) https://cpanmin.us > bin/cpanm 27 | $(AM_V_at)chmod 755 bin/cpanm 28 | 29 | $(CPANSNAPV): ../cpanfile 30 | $(AM_V_at)echo "** Installing Dependencies using Carton install" 31 | $(AM_V_at)test -f $(CPANSNAPV) && cp $(CPANSNAPV) ../cpanfile.snapshot || true 32 | test -x carton/bin/carton || $(PERL_ENV) $(PERL) bin/cpanm -q --notest --local-lib-contained $(THIRDPARTY_DIR)/carton Carton 33 | $(PERL_ENV) PERL5LIB=$(THIRDPARTY_DIR)/carton/lib/perl5 $(PERL) $(THIRDPARTY_DIR)/carton/bin/carton install 34 | $(AM_V_at)mv ../cpanfile.snapshot $(CPANSNAPV) 35 | $(AM_V_at)touch touch 36 | 37 | update: $(CPANSNAPV) 38 | $(AM_V_at)echo "** Updating Dependencies using Carton update" 39 | $(AM_V_at)cp $(CPANSNAPV) ../cpanfile.snapshot 40 | $(PERL_ENV) PERL5LIB=$(THIRDPARTY_DIR)/carton/lib/perl5 $(PERL) $(THIRDPARTY_DIR)/carton/bin/carton update 41 | $(AM_V_at)mv ../cpanfile.snapshot $(CPANSNAPV) 42 | 43 | clean-local: 44 | ls -1 | grep -v Makefile | grep -v cpanfile |grep -v bin | xargs rm -rf 45 | 46 | distclean-local: 47 | ls -1 | grep -v Makefile | grep -v cpanfile | xargs rm -rf 48 | 49 | install-exec-hook: 50 | cp -fr lib/perl5/* $(DESTDIR)$(libdir) 51 | -------------------------------------------------------------------------------- /update-changes.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -e 3 | [ `git status -s | wc -l` -gt 0 ] && echo "ERROR: commit all changes before release" && exit 1 4 | VERSION=`cat VERSION` 5 | echo ${V} `date +"%Y-%m-%d %H:%M:%S %z"` `git config user.name` '<'`git config user.email`'>' >> CHANGES.new 6 | echo >> CHANGES.new 7 | echo ' -' >> CHANGES.new 8 | echo >> CHANGES.new 9 | cat CHANGES >> CHANGES.new && mv CHANGES.new CHANGES 10 | $EDITOR CHANGES 11 | -------------------------------------------------------------------------------- /util/fix-pod2html.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use HTML::Parser; 5 | 6 | # fix pod2html output: 7 | # v1.0: defer and tags until 8 | # the next

,
or 9 | 10 | # v1.1: don't nest any elements; 11 | # end one before beginning another 12 | 13 | # v1.2: insert
tags if
occurs 14 | # inside
15 | 16 | # v1.3: anchors must not start with a digit; 17 | # insert a letter "N" at the start if they do 18 | 19 | # v1.4: insert the "N" letter into too. 20 | 21 | my $p = HTML::Parser->new(api_version => 3); 22 | $p->handler(start => \&startsub, 'tagname, text'); 23 | $p->handler(end => \&endsub, 'tagname, text'); 24 | $p->handler(default => sub { print shift() }, 'text'); 25 | $p->parse_file(shift||\*STDIN) or die("parse: $!"); 26 | 27 | my @stack; 28 | my $a=0; 29 | 30 | sub startsub { 31 | my $tag = shift; 32 | my $text = shift; 33 | if ($tag eq "dl") { 34 | if (@stack and $stack[0] eq "dt") { 35 | $stack[0] = "dd"; 36 | print "
"; 37 | } 38 | unshift @stack, 0; 39 | } 40 | if (($tag eq "dt" or $tag eq "dd") and $stack[0]) { 41 | print ""; 42 | $stack[0] = 0; 43 | } 44 | if ($tag eq "a") { 45 | if ($a) { 46 | print ""; 47 | } else { 48 | $a++; 49 | } 50 | $text =~ s/(name="|href="#)(\d)/$1N$2/; 51 | } 52 | print $text; 53 | } 54 | 55 | 56 | sub endsub { 57 | my $tag = shift; 58 | my $text = shift; 59 | if ($tag eq "dl") { 60 | print "" if $stack[0]; 61 | shift @stack; 62 | } 63 | if ($tag eq "a") { 64 | if ($a) { 65 | print ""; 66 | $a--; 67 | } 68 | } elsif ($tag eq "dd" or $tag eq "dt") { 69 | $stack[0] = $tag; 70 | } else { 71 | print $text; 72 | } 73 | } 74 | --------------------------------------------------------------------------------