aboutsummaryrefslogtreecommitdiffstats
path: root/include
diff options
context:
space:
mode:
Diffstat (limited to 'include')
-rw-r--r--include/FixedSNMP.pm125
-rwxr-xr-xinclude/config.pm.dist136
-rwxr-xr-xinclude/nms.pm186
-rw-r--r--include/nms/snmp.pm91
-rw-r--r--include/nms/util.pm141
-rwxr-xr-xinclude/nms/web.pm112
6 files changed, 0 insertions, 791 deletions
diff --git a/include/FixedSNMP.pm b/include/FixedSNMP.pm
deleted file mode 100644
index 1ea3089..0000000
--- a/include/FixedSNMP.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-# A bugfix to the gettable functions of SNMP.pm, that deals properly
-# with bulk responses being overridden. Original copyright:
-#
-# Copyright (c) 1995-2006 G. S. Marzot. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# To use, just "use FixedSNMP;" and then use SNMP::Session as usual.
-
-use strict;
-use warnings;
-use SNMP;
-
-package FixedSNMP::Session;
-
-sub _gettable_do_it() {
- my ($this, $vbl, $parse_indexes, $textnode, $state) = @_;
-
- my ($res);
-
- $vbl = $_[$#_] if ($state->{'options'}{'callback'});
-
- my $num_vbls = scalar @$vbl;
- my $num_stopconds = scalar @{$state->{'stopconds'}};
-
- while ($num_vbls > 0 && !$this->{ErrorNum}) {
- my @found_eof = (0) x $num_stopconds;
-
- for (my $i = 0; $i <= $#$vbl; $i++) {
- my $row_oid = SNMP::translateObj($vbl->[$i][0]);
- my $row_text = $vbl->[$i][0];
- my $row_index = $vbl->[$i][1];
- my $row_value = $vbl->[$i][2];
- my $row_type = $vbl->[$i][3];
-
- my $stopcond_num = $i % $num_stopconds;
- my $stopcond = $state->{'stopconds'}[$stopcond_num];
- if ($row_oid !~ /^\Q$stopcond\E/ || $row_value eq 'ENDOFMIBVIEW') {
- $found_eof[$stopcond_num] = 1;
- } else {
-
- if ($row_type eq "OBJECTID") {
-
- # If the value returned is an OID, translate this
- # back in to a textual OID
-
- $row_value = SNMP::translateObj($row_value);
-
- }
-
- # continue past this next time
-
- $state->{'varbinds'}[$stopcond_num] = [ $row_text, $row_index ];
-
- # Place the results in a hash
-
- $state->{'result_hash'}{$row_index}{$row_text} = $row_value;
- }
- }
-
- my @newstopconds = ();
- my @newvarbinds = ();
- for (my $i = 0; $i < $num_stopconds; ++$i) {
- unless ($found_eof[$i]) {
- push @newstopconds, $state->{'stopconds'}[$i];
- push @newvarbinds, $state->{'varbinds'}[$i];
- }
- }
- if ($#newstopconds == -1) {
- last;
- }
- $state->{'varbinds'} = \@newvarbinds;
- $state->{'stopconds'} = \@newstopconds;
- $vbl = $state->{'varbinds'};
- $num_vbls = scalar @newvarbinds;
- $num_stopconds = scalar @newstopconds;
-
- #
- # if we've been configured with a callback, then call the
- # sub-functions with a callback to our own "next" processing
- # function (_gettable_do_it). or else call the blocking method and
- # call the next processing function ourself.
- #
- if ($state->{'options'}{'callback'}) {
- if ($this->{Version} ne '1' && !$state->{'options'}{'nogetbulk'}) {
- $res = $this->getbulk(0, $state->{'repeatcount'}, $vbl,
- [\&_gettable_do_it, $this, $vbl,
- $parse_indexes, $textnode, $state]);
- } else {
- $res = $this->getnext($vbl,
- [\&_gettable_do_it, $this, $vbl,
- $parse_indexes, $textnode, $state]);
- }
- return;
- } else {
- if ($this->{Version} ne '1' && !$state->{'options'}{'nogetbulk'}) {
- $res = $this->getbulk(0, $state->{'repeatcount'}, $vbl);
- } else {
- $res = $this->getnext($vbl);
- }
- }
- }
-
- # finish up
- _gettable_end_routine($state, $parse_indexes, $textnode);
-
- # return the hash if no callback was specified
- if (!$state->{'options'}{'callback'}) {
- return($state->{'result_hash'});
- }
-
- #
- # if they provided a callback, call it
- # (if an array pass the args as well)
- #
- if (ref($state->{'options'}{'callback'}) eq 'ARRAY') {
- my $code = shift @{$state->{'options'}{'callback'}};
- $code->(@{$state->{'options'}{'callback'}}, $state->{'result_hash'});
- } else {
- $state->{'options'}{'callback'}->($state->{'result_hash'});
- }
-}
-
-*FixedSNMP::Session::_gettable_end_routine = *SNMP::Session::_gettable_end_routine;
-*SNMP::Session::_gettable_do_it = *FixedSNMP::Session::_gettable_do_it;
diff --git a/include/config.pm.dist b/include/config.pm.dist
deleted file mode 100755
index cf1362a..0000000
--- a/include/config.pm.dist
+++ /dev/null
@@ -1,136 +0,0 @@
-#! /usr/bin/perl
-use strict;
-use warnings;
-use DBI;
-package nms::config;
-
-# DB
-our $db_name = "nms";
-our $db_host = "bb-8.tg16.gathering.org";
-our $db_username = "nms";
-our $db_password = "<removed>"; # TODO: Remove before publishing "goodiebag"
-
-# Gondul
-our $gondul_url = "http://foo.bar"; # TODO: Remove before publishing "goodiebag"
-our $gondul_user = "secret"; # TODO: Remove before publishing "goodiebag"
-our $gondul_pass = "<removed>"; # TODO: Remove before publishing "goodiebag"
-
-# NMS: What SNMP objects to fetch.
-# Some basics
-our @snmp_objects = [
-['ifIndex'],
-['sysName'],
-['sysDescr'],
-['ifHighSpeed'],
-['ifType'],
-['ifName'],
-['ifDescr'],
-['ifAlias'],
-['ifOperStatus'],
-['ifAdminStatus'],
-['ifLastChange'],
-['ifHCInOctets'],
-['ifHCOutOctets'],
-['ifInDiscards'],
-['ifOutDiscards'],
-['ifInErrors'],
-['ifOutErrors'],
-['ifInUnknownProtos'],
-['ifOutQLen'],
-['sysUpTime'],
-['jnxOperatingTemp'],
-['jnxOperatingCPU'],
-['jnxOperatingDescr'],
-['jnxBoxSerialNo']
-];
-# Max SNMP polls to fire off at the same time.
-our $snmp_max = 20;
-
-# DHCP-servers
-our $dhcp_server1 = "185.110.149.2"; # primary
-our $dhcp_server2 = "185.110.148.2"; # secondary
-
-# TACACS-login for NMS
-our $tacacs_user = "<removed>"; # TODO: Remove before publishing "goodiebag"
-our $tacacs_pass = "<removed>"; # TODO: Remove before publishing "goodiebag"
-
-# Telnet-timeout for smanagrun
-our $telnet_timeout = 300;
-
-# IP/IPv6/DNS-info
-our $tgname = "tg16";
-our $pri_hostname = "r2-d2";
-our $pri_v4 = "185.110.149.2";
-our $pri_v6 = "2a06:5841:149a::2";
-our $pri_net_v4 = "185.110.149.0/26";
-our $pri_net_v6 = "2a06:5841:149a::/64";
-
-our $sec_hostname = "c-3po";
-our $sec_v4 = "185.110.148.2";
-our $sec_v6 = "2a06:5841:1337::2";
-our $sec_net_v4 = "185.110.148.0/26";
-our $sec_net_v6 = "2a06:5841:1337::/64";
-
-# for RIPE to get reverse zones via DNS AXFR
-# https://www.ripe.net/data-tools/dns/reverse-dns/how-to-set-up-reverse-delegation
-our $ext_xfer = "193.0.0.0/22; 2001:610:240::/48; 2001:67c:2e8::/48";
-
-# allow XFR from NOC
-our $noc_net = "185.110.150.0/25; 2a06:5841:150a::1/64";
-
-# To generate new dnssec-key for ddns:
-# dnssec-keygen -a HMAC-MD5 -b 512 -n HOST DHCP_UPDATER
-our $ddns_key = "<removed>"; # TODO: Remove before publishing "goodiebag"
-our $ddns_to = "127.0.0.1"; # just use localhost
-
-# Base networks
-our $base_ipv4net = "88.92.0.0/17";
-our $base_ipv6net = "2a06:5840::/29";
-our $ipv6zone = "0.4.8.5.6.0.a.2.ip6.arpa";
-
-# extra networks that are outside the normal ranges
-# that should have recursive DNS access
-our @rec_net = (
- '185.110.148.0/22',
-);
-
-# extra networks that are outside the normal ranges
-# that should be added to DNS
-our @extra_nets = (
- '185.110.148.0/24',
- '185.110.149.0/24',
- '185.110.150.0/24',
- '185.110.151.0/24',
-);
-
-# add WLC's
-our $wlc1_v4 = "185.110.148.14";
-our $wlc1_v6 = "f00d::1";
-
-# add VOIP-server
-our $voip1_v4 = "<removed>"; # TODO: Remove before publishing "goodiebag"
-our $voip1_v6 = "<removed>"; # TODO: Remove before publishing "goodiebag"
-
-# PXE-server (rest of bootstrap assumes $sec_v4/$sec_v6)
-our $pxe_server_v4 = $sec_v4;
-our $pxe_server_v6 = $sec_v6;
-
-# FAP-server (Gondul)
-our $fap_server_v4 = "<removed>"; # TODO: Remove before publishing "goodiebag"
-our $fap_server_v6 = "<removed>"; # TODO: Remove before publishing "goodiebag"
-our @fap_networks = (
- '88.92.54.0/26', # distro0
- '88.92.54.64/26', # distro1
- '88.92.54.128/26', # distro2
- '88.92.54.192/26', # distro3
- '88.92.55.0/26', # distro4
- '88.92.55.64/26', # distro5
- '88.92.55.128/26', # distro6
- '88.92.55.192/26', # distro7
- '88.92.56.0/26', # distro8
- '88.92.56.64/26', # vc1.ring
-);
-
-
-
-1;
diff --git a/include/nms.pm b/include/nms.pm
deleted file mode 100755
index 2ec922b..0000000
--- a/include/nms.pm
+++ /dev/null
@@ -1,186 +0,0 @@
-#! /usr/bin/perl
-use strict;
-use warnings;
-use DBI;
-use Net::OpenSSH;
-use Net::Telnet;
-use Data::Dumper;
-use FileHandle;
-use JSON;
-package nms;
-
-use base 'Exporter';
-our @EXPORT = qw(switch_disconnect switch_connect_ssh switch_connect_dlink switch_exec switch_exec_json switch_timeout db_connect);
-
-BEGIN {
- require "config.pm";
- eval {
- require "config.local.pm";
- };
-}
-
-
-sub db_connect {
- my $connstr = "dbi:Pg:dbname=" . $nms::config::db_name;
- $connstr .= ";host=" . $nms::config::db_host unless (!defined($nms::config::db_host));
-
- my $dbh = DBI->connect($connstr,
- $nms::config::db_username,
- $nms::config::db_password, {AutoCommit => 0})
- or die "Couldn't connect to database";
- return $dbh;
-}
-
-sub switch_connect_ssh($) {
- my ($ip) = @_;
- my $ssh = Net::OpenSSH->new($ip,
- user => $nms::config::tacacs_user,
- password => $nms::config::tacacs_pass,
- master_opts => [ "-o", "StrictHostKeyChecking=no" ]);
- my ($pty, $pid) = $ssh->open2pty({stderr_to_stdout => 1})
- or die "unable to start remote shell: " . $ssh->error;
-
- my $dumplog = FileHandle->new;
- $dumplog->open(">>/tmp/dumplog-queue") or die "/tmp/dumplog-queue: $!";
- #$dumplog->print("\n\nConnecting to " . $ip . "\n\n");
-
- my $inputlog = FileHandle->new;
- $inputlog->open(">>/tmp/inputlog-queue") or die "/tmp/inputlog-queue: $!";
- #$inputlog->print("\n\nConnecting to " . $ip . "\n\n");
-
- my $telnet = Net::Telnet->new(-fhopen => $pty,
- -timeout => $nms::config::telnet_timeout,
- -dump_log => $dumplog,
- -input_log => $inputlog,
- -prompt => '/.*\@[a-z0-9-]+[>#] /',
- -telnetmode => 0,
- -cmd_remove_mode => 1,
- -output_record_separator => "\r");
- $telnet->waitfor(-match => $telnet->prompt,
- -errmode => "return")
- or die "login failed: " . $telnet->lastline;
-
- $telnet->cmd("set cli screen-length 0");
-
- return { telnet => $telnet, ssh => $ssh, pid => $pid, pty => $pty };
-}
-
-sub switch_connect_dlink($) {
- my ($ip) = @_;
-
- my $dumplog = FileHandle->new;
- $dumplog->open(">>/tmp/dumplog-queue") or die "/tmp/dumplog-queue: $!";
- $dumplog->print("\n\nConnecting to " . $ip . "\n\n");
-
- my $inputlog = FileHandle->new;
- $inputlog->open(">>/tmp/inputlog-queue") or die "/tmp/inputlog-queue: $!";
- $inputlog->print("\n\nConnecting to " . $ip . "\n\n");
-
- my $conn = new Net::Telnet( Timeout => $nms::config::telnet_timeout,
- Dump_Log => $dumplog,
- Input_Log => $inputlog,
- Errmode => 'return',
- Prompt => '/[\S\-\_]+[#>]/');
- my $ret = $conn->open( Host => $ip);
- if (!$ret || $ret != 1) {
- return (undef);
- }
- # Handle login with and without password
- print "Logging in without password\n";
- $conn->waitfor('/User ?Name:/');
- $conn->print('admin');
- my (undef, $match) = $conn->waitfor('/DGS-3100#|Password:/');
- die 'Unexpected prompt after login attempt' if (not defined $match);
- if ($match eq 'Password:') {
- $conn->print('gurbagurba'); # Dette passordet skal feile
- $conn->waitfor('/User ?Name:/');
- $conn->print($nms::config::tacacs_user);
- my (undef, $match) = $conn->waitfor('/DGS-3100#|Password:/');
- if ($match eq 'Password:') {
- $conn->cmd($nms::config::tacacs_pass);
- }
- }
- return { telnet => $conn };
-}
-
-# Send a command to switch and return the data recvied from the switch
-sub switch_exec {
- my ($cmd, $conn, $print) = @_;
-
- sleep 1; # don't overload the D-Link
-
- # Send the command and get data from switch
- my @data;
- if (defined($print)) {
- $conn->print($cmd);
- return;
- } else {
- @data = $conn->cmd($cmd);
- print "ERROR: " . $conn->errmsg . "\n" if $conn->errmsg;
- }
- return @data;
-}
-
-sub switch_exec_json($$) {
- my ($cmd, $conn) = @_;
- my @json = switch_exec("$cmd | display json", $conn);
- pop @json; # Remove the banner at the end of the output
- return ::decode_json(join("", @json));
-}
-
-sub switch_timeout {
- my ($timeout, $conn) = @_;
-
- $conn->timeout($timeout);
- return ('Set timeout to ' . $timeout);
-}
-
-sub switch_disconnect($) {
- my ($struct) = @_;
- my $conn = $struct->{telnet};
- $conn->close();
- if ($struct->{pid}) {
- waitpid($struct->{pid}, 0);
- }
-}
-# A few utilities to convert from SNMP binary address format to human-readable.
-
-sub convert_mac {
- return join(':', map { sprintf "%02x", $_ } unpack('C*', shift));
-}
-
-sub convert_ipv4 {
- return join('.', map { sprintf "%d", $_ } unpack('C*', shift));
-}
-
-sub convert_ipv6 {
- return join(':', map { sprintf "%x", $_ } unpack('n*', shift));
-}
-
-sub convert_addr {
- my ($data, $type) = @_;
- if ($type == 1) {
- return convert_ipv4($data);
- } elsif ($type == 2) {
- return convert_ipv6($data);
- } else {
- die "Unknown address type $type";
- }
-}
-
-# Convert raw binary SNMP data to list of bits.
-sub convert_bytelist {
- return split //, unpack("B*", shift);
-}
-
-sub convert_lldp_caps {
- my ($caps_data, $data) = @_;
-
- my @caps = convert_bytelist($caps_data);
- my @caps_names = qw(other repeater bridge ap router telephone docsis stationonly);
- for (my $i = 0; $i < scalar @caps && $i < scalar @caps_names; ++$i) {
- $data->{'cap_enabled_' . $caps_names[$i]} = $caps[$i];
- }
-}
-
-1;
diff --git a/include/nms/snmp.pm b/include/nms/snmp.pm
deleted file mode 100644
index 26ada44..0000000
--- a/include/nms/snmp.pm
+++ /dev/null
@@ -1,91 +0,0 @@
-#! /usr/bin/perl
-use strict;
-use warnings;
-use SNMP;
-use nms;
-package nms::snmp;
-
-use base 'Exporter';
-our @EXPORT = qw();
-
-BEGIN {
- # $SNMP::debugging = 1;
-
- # sudo mkdir /usr/share/mibs/site
- # cd /usr/share/mibs/site
- # wget -O- ftp://ftp.cisco.com/pub/mibs/v2/v2.tar.gz | sudo tar --strip-components=3 -zxvvf -
- SNMP::initMib();
- SNMP::addMibDirs("/srv/tgmanage/mibs/StandardMibs");
- SNMP::addMibDirs("/srv/tgmanage/mibs/JuniperMibs");
-
- SNMP::loadModules('SNMPv2-MIB');
- SNMP::loadModules('ENTITY-MIB');
- SNMP::loadModules('IF-MIB');
- SNMP::loadModules('LLDP-MIB');
- SNMP::loadModules('IP-MIB');
- SNMP::loadModules('IP-FORWARD-MIB');
-}
-
-sub snmp_open_session {
- my ($ip, $community, $async) = @_;
-
- $async //= 0;
-
- my %options = (UseEnums => 1);
- if ($ip =~ /:/) {
- $options{'DestHost'} = "udp6:$ip";
- } else {
- $options{'DestHost'} = "udp:$ip";
- }
-
- if ($community =~ /^snmpv3:(.*)$/) {
- my ($username, $authprotocol, $authpassword, $privprotocol, $privpassword) = split /\//, $1;
-
- $options{'SecName'} = $username;
- $options{'SecLevel'} = 'authNoPriv';
- $options{'AuthProto'} = $authprotocol;
- $options{'AuthPass'} = $authpassword;
-
- if (defined($privprotocol) && defined($privpassword)) {
- $options{'SecLevel'} = 'authPriv';
- $options{'PrivProto'} = $privprotocol;
- $options{'PrivPass'} = $privpassword;
- }
-
- $options{'Version'} = 3;
- } else {
- $options{'Community'} = $community;
- $options{'Version'} = 2;
- }
-
- my $session = SNMP::Session->new(%options);
- if (defined($session) && ($async || defined($session->getnext('sysDescr')))) {
- return $session;
- } else {
- die 'Could not open SNMP session to ' . $ip;
- }
-}
-
-# Not currently in use; kept around for reference.
-sub fetch_multi_snmp {
- my ($session, @oids) = @_;
-
- my %results = ();
-
- # Do bulk reads of 40 and 40; seems to be about the right size for 1500-byte packets.
- for (my $i = 0; $i < scalar @oids; $i += 40) {
- my $end = $i + 39;
- $end = $#oids if ($end > $#oids);
- my @oid_slice = @oids[$i..$end];
-
- my $localresults = $session->get_request(-varbindlist => \@oid_slice);
- return undef if (!defined($localresults));
-
- while (my ($key, $value) = each %$localresults) {
- $results{$key} = $value;
- }
- }
-
- return \%results;
-}
-
diff --git a/include/nms/util.pm b/include/nms/util.pm
deleted file mode 100644
index 64637b8..0000000
--- a/include/nms/util.pm
+++ /dev/null
@@ -1,141 +0,0 @@
-#! /usr/bin/perl
-use strict;
-use warnings;
-package nms::util;
-use Data::Dumper;
-
-use base 'Exporter';
-our @EXPORT = qw(guess_placement parse_switches_txt parse_switches parse_switch);
-
-# Parse a single switches.txt-formatted switch
-sub parse_switch {
- my ($switch, $subnet4, $subnet6, $mgtmt4, $mgtmt6, $lolid, $distro) = split(/ /);
- my %foo = guess_placement($switch);
- my %ret = (
- 'sysname' => "$switch",
- 'subnet4' => "$subnet4",
- 'subnet6' => "$subnet6",
- 'mgmt_v4_addr' => "$mgtmt4",
- 'mgmt_v6_addr' => "$mgtmt6",
- 'traffic_vlan' => "$lolid",
- 'distro' => "$distro"
- );
- %{$ret{'placement'}} = guess_placement($switch);
- return %ret;
-}
-
-# Parses a switches_txt given as a filehandle on $_[0]
-# (e.g.: parse_switches_txt(*STDIN) or parse_switches_txt(whatever).
-sub parse_switches_txt {
- my $fh = $_[0];
- my @switches;
- while(<$fh>) {
- chomp;
- my %switch = parse_switch($_);
- push @switches, {%switch};
- }
- return @switches;
-}
-
-# Parses switches in switches.txt format given as $_[0].
-# E.g: parse_switches("e1-3 88.92.0.0/26 2a06:5840:0a::/64 88.92.54.2/26 2a06:5840:54a::2/64 1013 distro0")
-sub parse_switches {
- my @switches;
- my $txt = $_[0];
- foreach (split("\n",$txt)) {
- chomp;
- my %switch = parse_switch($_);
- push @switches, {%switch};
- }
- return @switches;
-}
-
-# Guesses placement from name to get a starting point
-# Largely courtesy of Knuta
-sub guess_placement {
- my ($x, $y, $xx, $yy);
-
- my $name = $_[0];
- my $src = "unknown";
- if ($name =~ /^e\d+-\d+$/) {
- $name =~ /e(\d+)-(\d+)/;
- my ($e, $s) = ($1, $2);
- $src = "main";
-
- $x = int(292 + (($e-1)/2) * 31.1);
- $y = undef;
-
- $x += 14 if ($e >= 13);
- $x += 14 if ($e >= 25);
- $x += 14 if ($e >= 41);
- $x += 14 if ($e >= 59);
-
- if ($s > 2) {
- $y = 405 - 120 * ($s-2);
- } else {
- $y = 689 - 120 * ($s);
- }
-
- $xx = $x + 16;
- $yy = $y + 120;
-
- # Justeringer
- $y += 45 if $name eq "e1-4";
- $y += 20 if $name eq "e3-4";
- $y += 15 if $name eq "e5-4";
- $yy -= 25 if $name eq "e7-1";
- $y += 10 if $name eq "e5-2";
- $yy -= 25 if $name eq "e5-2";
- $y += 20 if ($e >= 81 and $s == 2);
- $yy -= 20 if ($e >= 79 and $s == 1);
- $yy -= 30 if ($e >= 81 and $s == 1);
-
- } elsif ($name =~ /^creativia(\d+)$/) {
- my ($s) = ($1);
- $src = "creativia";
- $x = 1535;
- $y = int(160 + 32.2 * $s);
- $yy = $y + 20;
- if ($s == 1) {
- $xx = $x + 70;
- } elsif ($s == 2) {
- $xx = $x + 90;
- } elsif ($s == 3) {
- $xx = $x + 102;
- } else {
- $xx = $x + 142;
- }
-
- } elsif ($name =~ /^crew(\d+)-(\d+)$/) {
- my ($s, $n) = ($1, $2);
- $src = "crew";
- $x = 550 + 65 * $n;
- $y = int(759 + 20.5 * $s);
- $xx = $x + 65;
- $yy = $y + 14;
- } elsif ($name =~ /^distro(\d)/) {
- my $d = ($1);
- $src = "distro";
- $x = 292 + $d * 165;
- $y = 415;
- $xx = $x + 130;
- $yy = $y + 20;
- } else {
- # Fallback to have _some_ position
- $src = "random";
- $x = int(rand(500));
- $y = int(rand(500));
- $xx = $x + 20;
- $yy = $y + 130;
- };
-
-
- my %box = (
- 'src' => "$src",
- 'x1' => $x,
- 'y1' => $y,
- 'xx' => $xx,
- 'yy' => $yy
- );
- return %box;
-}
diff --git a/include/nms/web.pm b/include/nms/web.pm
deleted file mode 100755
index 7c9339e..0000000
--- a/include/nms/web.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-#! /usr/bin/perl
-# vim:ts=8:sw=8
-use strict;
-use warnings;
-use utf8;
-use DBI;
-use Data::Dumper;
-use JSON;
-use nms;
-use Digest::SHA;
-use FreezeThaw;
-use URI::Escape;
-package nms::web;
-
-use base 'Exporter';
-our %get_params;
-our %json;
-our @EXPORT = qw(finalize_output now json $dbh db_safe_quote %get_params get_input %json);
-our $dbh;
-our $now;
-our $when;
-our %cc;
-
-sub get_input {
- my $in = "";
- while(<STDIN>) { $in .= $_; }
- return $in;
-}
-# Print cache-control from %cc
-sub printcc {
- my $line = "";
- my $first = "";
- foreach my $tmp (keys(%cc)) {
- $line .= $first . $tmp . "=" . $cc{$tmp};
- $first = ", ";
- }
- print 'Cache-Control: ' . $line . "\n";
-}
-
-sub db_safe_quote {
- my $word = $_[0];
- my $term = $get_params{$word};
- if (!defined($term)) {
- if(defined($_[1])) {
- $term = $_[1];
- } else {
- die "Missing CGI param $word";
- }
- }
- return $dbh->quote($term) || die;
-}
-
-# returns a valid $when statement
-# Also sets cache-control headers if time is overridden
-# This can be called explicitly to override the window of time we evaluate.
-# Normally up to 15 minutes old data will be returned, but for some API
-# endpoints it is better to return no data than old data (e.g.: ping).
-sub setwhen {
- $now = "now()";
- my $window = '8m';
- my $offset = '0s';
- if (@_ > 0) {
- $window = $_[0];
- }
- if (@_ > 1) {
- $offset = $_[1];
- }
- if (defined($get_params{'now'})) {
- $now = db_safe_quote('now') . "::timestamp with time zone ";
- $cc{'max-age'} = "3600";
- }
- $now = "(" . $now . " - '" . $offset . "'::interval)";
- $when = " time > " . $now . " - '".$window."'::interval and time < " . $now . " ";
-}
-
-sub finalize_output {
- my $query;
- my $hash = Digest::SHA::sha512_base64(FreezeThaw::freeze(%json));
- $dbh->commit;
- $query = $dbh->prepare('select extract(epoch from date_trunc(\'seconds\', ' . $now . ')) as time;');
- $query->execute();
-
- $json{'time'} = int($query->fetchrow_hashref()->{'time'});
- $json{'hash'} = $hash;
-
- printcc;
-
- print "Etag: $hash\n";
- print "Access-Control-Allow-Origin: *\n";
- print "Access-Control-Allow-Methods: HEAD, GET\n";
- print "Content-Type: text/json; charset=utf-8\n\n";
- print JSON::XS::encode_json(\%json);
- print "\n";
-}
-
-sub populate_params {
- my $querystring = $ENV{'QUERY_STRING'} || "";
- foreach my $hdr (split("&",$querystring)) {
- my ($key, $value) = split("=",$hdr,"2");
- $get_params{$key} = URI::Escape::uri_unescape($value);
- }
-}
-
-BEGIN {
- $cc{'stale-while-revalidate'} = "3600";
- $cc{'max-age'} = "20";
-
- $dbh = nms::db_connect();
- populate_params();
- setwhen();
-}
-1;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-27 03:55:55 +0000