#!/usr/local/bin/perl
######################################################################
### Sample CGI script using the Perl 5 SNMP Module
###
### This script can be used as a CGI script with an HTTP Daemon, to
### allow asking SNMP queries from a World-Wide Web client.
###
######################################################################
### When called with an empty QUERY_STRING environment variable, a
### form is generated that lets the user fill in a host and community
### name.  When the filled-in form is submitted, the script will be
### called again, this time with parameters passed through
### $QUERY_STRING.  It will make an SNMP query to the selected
### host/community and return the results as an HTML document
### containing an HTML 3 table which shows the names and values of
### some MIB variable instances.
######################################################################

require 5;

require 'SNMP_Session.pm';
use BER;

sub parse_query;
sub init_oids;
sub query_to_html_response;
sub snmp_get;
sub write_query_form;
sub html_error_message;
sub html_quote;

my @allowed_hosts=qw(swiEG1.switch.ch swiCS1.switch.ch swiZHX.switch.ch swiCE1.switch.ch swiNY1.switch.ch);
my %allowed_hosts;

my $intro = <<EOM;
<P> This is a sample application of an
<A HREF="http://www.switch.ch/misc/leinen/snmp/perl/">SNMP Module</A>
I have written for Perl 5. </P>
EOM

foreach (@allowed_hosts) { $allowed_hosts{$_} = 1; }

my $query_string = $ENV{'QUERY_STRING'};

if (!defined ($query_string) || !$query_string) {
    write_query_form ();
} else {
    my (%query) = parse_query ();
    init_oids ();
    if (! defined ($allowed_hosts{$query{'hostname'}})) {
	print "Content-type: text/html\n\n";
	html_error_message ("parsing the query", "Illegal hostname");
    } else {
	query_to_html_response ($query{'hostname'}, $query{'community'});
    }
}
1;

sub parse_query
{
    my (%query) = (());
    foreach (split('&',$query_string)) {
	($lhs,$rhs) = split('=',$_,2);
	$query{$lhs} = $rhs if $rhs;
    }
    return %query;
}

sub init_oids
{
    %ugly_oids = qw(sysDescr.0		1.3.6.1.2.1.1.1.0
		    sysLocation.0	1.3.6.1.2.1.1.6.0
		    );
    foreach (keys %ugly_oids) {
	$ugly_oids{$_} = encode_oid (split (/\./, $ugly_oids{$_}));
	$pretty_oids{$ugly_oids{$_}} = $_;
    }
}

sub query_to_html_response
{
    local($hostname, $community) = @_;

    if ($community eq 'public'
	&& -r "/home/leinen/snmp/.zxc") {
	open (COMM, "/home/leinen/snmp/.zxc");
	$community = <COMM>;
	chomp $community;
	close COMM;
    }
    print "Content-type: text/html\n\n",
    "<HTML><HEAD><TITLE>Perl SNMP Module Test</TITLE>\n",
    "</HEAD>\n<BODY BGCOLOR=\"#ffffff\">\n",
    "<H1>SNMP query to ",
    html_quote ($community), "@", html_quote ($hostname), "</H1>\n<HR>\n";

    srand();
    eval '$session = SNMP_Session->open ($hostname, $community, 161)';
    html_error_message ("opening SNMP session", $@), return 0 if $@;
    eval { snmp_get ($session, qw(sysDescr.0 sysLocation.0)) };
    html_error_message ("executing SNMP query", $@), return 0 if $@;
    $session->close ();

    print "</BODY>\n</HTML>\n";
    1;
}

sub snmp_get
{
    my($session, @oids) = @_;
    my($response, $bindings, $binding, $value, $oid);
    grep ($_ = $ugly_oids{$_}, @oids);
    if ($session->get_request_response (@oids)) {
	$response = $session->pdu_buffer;
	($bindings) = $session->decode_get_response ($response);

	print "<TABLE BORDER>\n";
	while ($bindings ne '') {
	    ($binding,$bindings) = decode_sequence ($bindings);
	    ($oid,$value) = decode_by_template ($binding, "%O%@");
	    print "<TR>",
	    "<TH ALIGN=RIGHT>", $pretty_oids{$oid}, "</TH>",
	    "<TD ALIGN=LEFT><PRE>", &html_quote (pretty_print ($value)), "</PRE></SAMP></TD>",
	    "</TR>\n";
	}
	print "</TABLE>\n";
	1;
    } else {
	die "No response received.\n";
    }
}

sub write_query_form
{
    print <<EOM;
Content-type: text/html
Content-transfer-encoding: binary

<HTML>
<HEAD><TITLE>Perl SNMP Module Test</TITLE></HEAD>
<BODY BGCOLOR="#ffffff">
<H1>Perl SNMP Module Test</H1>
<HR>
$intro
<FORM>
Host name:
<SELECT NAME=hostname>
<OPTION SELECTED VALUE="swiEG1.switch.ch">swiEG1.switch.ch
<OPTION VALUE="swiCS1.switch.ch">swiCS1.switch.ch
<OPTION VALUE="swiZHX.switch.ch">swiZHX.switch.ch
<OPTION VALUE="swiCE1.switch.ch">swiCE1.switch.ch
<OPTION VALUE="swiNY1.switch.ch">swiNY1.switch.ch
</SELECT>
Community name:
<SELECT NAME=community>
<OPTION VALUE="public">public
</SELECT>
<BR>
<INPUT TYPE=submit VALUE="Send request">
<INPUT TYPE=reset VALUE="Clear">
</FORM>
<HR>
<ADDRESS>
<A HREF="http://www.switch.ch/misc/leinen/">
 Simon Leinen &lt;simon\@switch.ch&gt;</A>
</ADDRESS>
</BODY>
</HTML>
EOM
}

sub html_error_message
{
    my($context, $errmsg) = @_;

    print "<H2>SNMP Error</H2>\n<HR>\n";
    print "<P>While ",$context,", the following error occurred:</P>\n";
    print "<PRE>",&html_quote($errmsg),"</PRE></BODY></HTML>";
}

sub html_quote
{
    local ($_) = @_;

    return $_ unless /[<>&]/;
    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
    $_;
}
