#!/usr/bin/perl
#-------------------------------------------------------------------------
#
# dialup	CGI program to monitor and control a dial-up interface
#		from several network client.
#		Bring the interface up when the first client requires
#		it, and bring it down when the last client stops.
#
# Version	1.0	4 April 2001
#
# Author:	Niccolo Rigacci <niccolo@rigacci.org>
#
#-------------------------------------------------------------------------

use CGI qw(:standard);
use POSIX;

#-------------------------------------------------------------------------
# Configurable items
#-------------------------------------------------------------------------

# Interface used for dial-up.
$IFACE = 'ppp0';

# Hosts allowed to control dial-up.
$HOST_ALLOW='192.168.2.*';

# Where to create temporary files (must be writable by web server).
$ACTIVE_CLIENTS = '/var/www/dial-up';

# Ask the browser to automatically reload the page every N seconds.
$REFRESH_INTERVAL = '20';

# Standard shell commands.
$LS = '/bin/ls -rc';
$TOUCH = '/usr/bin/touch';
$IFCONFIG = '/sbin/ifconfig';

# Commands to start and stop the dial-up interface,
# they will be executed with web server privileges.
$PPPON = '/usr/bin/pon';
$PPPOFF = '/usr/bin/poff';

# Button captions.
$ADD = 'Require dial-up';
$REMOVE = 'Do not require';
$REFRESH = 'Refresh screen';
$REMOVEALL = 'Remove all hosts';

# Interface status.
$UP = 'UP';
$DOWN = 'DOWN';
$GOINGUP = 'GOING-UP';
$GOINGDOWN = 'GOING-DOWN';

# Color for printing interface status.
%color = (
    $UP => 'red',
    $DOWN => 'black',
    $GOINGUP => 'blue',
    $GOINGDOWN => 'blue'
);

#-------------------------------------------------------------------------
# End of configurable items
#-------------------------------------------------------------------------

# Convert to a regexp escaping dots and stars.
$HOST_ALLOW =~ s/\./\\\./g;
$HOST_ALLOW =~ s/\*/\\d{1,3}/g;
$HOST_ALLOW = '^' . $HOST_ALLOW . '$';

# Get the IP address of remote client.
$remote_ip_address = remote_addr();

# Check if remote client is allowed to use this CGI.
unless ($remote_ip_address =~ /$HOST_ALLOW/) {
    print header,
          start_html('Dial-up manager'), "\n",
          h1('Dial-up manager'), "\n",
          b('Access denied'), "\n",
          end_html;
    die;
}

# Get client hostname, if possible.
$remote_host_name = gethostbyaddr pack('C4', split (/\./, $remote_ip_address)), 2;
$remote_host_name ||= 'no_name';

# Get the interface status.
if (grep /^$IFACE /, `$IFCONFIG`) {
    $interface_status = $UP;
} else {
    $interface_status = $DOWN;
}

# Do the required action, if any.
if (param()) {
    $filename = "${ACTIVE_CLIENTS}/${remote_ip_address}_${remote_host_name}";

    if (param('_action_') eq $ADD) {
        # The client requires dial-up: create file and start interface if down.
        `$TOUCH "$filename"` unless (-f "$filename");
        if ($interface_status eq $DOWN) {
            $interface_status = $GOINGUP;
            `$PPPON`;
        }
    } elsif (param('_action_') eq $REMOVE) {
        # The client doesn't longer require dial-up. Remove file and bring the
        # dial-up interface down if no other clients require it.
        unlink "$filename";
        @active_clients = `$LS $ACTIVE_CLIENTS`;
        if (! @active_clients) {
            $interface_status = $GOINGDOWN if ($interface_status eq $UP);
            `$PPPOFF`;
        }
    } elsif (param('_action_') eq $REMOVEALL) {
        # The client requires bringing the interface down, thus removing all
        # other clients from the list.
        @active_clients = `$LS $ACTIVE_CLIENTS`;
        foreach $client_file (@active_clients) {
            chomp $client_file;
            unlink "${ACTIVE_CLIENTS}/$client_file";
        }
        $interface_status = $GOINGDOWN if ($interface_status eq $UP);
        `$PPPOFF`;
    }
}

# Start printing the HTML page.
print header(-refresh=>$REFRESH_INTERVAL . '; URL=' . script_name(), -pragma=>'no-cache'),
      start_html('Dial-up manager'), "\n",
      h1('Dial-up manager'), "\n",
      font({-color=>$color{$interface_status}},
      b("Dial-up interface $IFACE is $interface_status")), "\n",
      p, "\n",
      b("Your host is $remote_ip_address ($remote_host_name)"), "\n",
      start_form,
      p, "\n",
      submit(-name=>'_action_', -value=>"$ADD"), '&nbsp;', "\n",
      submit(-name=>'_action_', -value=>"$REMOVE"), '&nbsp;', "\n",
      p, "\n",
      hr, "\n",
      b('Hosts requiring dial-up interface'), "\n",
      p, "\n";

@rows = th({-width=>'100', -align=>'left'}, 'Date').
        th({-width=>'70',  -align=>'left'}, 'Time').
        th({-width=>'120', -align=>'left'}, 'Uptime (m:ss)').
        th({-width=>'250', -align=>'left'}, 'Host');

# Print the list of the clients currently requiring dial-up interface.
foreach $filename (`$LS $ACTIVE_CLIENTS`) {
    chomp $filename;
    ($dev, $ino, $mode, $nlink,
    $uid, $gid, $rdev, $size,
    $atime, $mtime, $ctime,
    $blksize, $blocks) = stat "$ACTIVE_CLIENTS/$filename";
    $date = strftime("%Y-%m-%d", localtime($ctime));
    $time = strftime("%H:%M:%S", localtime($ctime));
    $uptime = (time() - $ctime);
    $upmin = int($uptime / 60);
    $upsec = $uptime - $upmin * 60;
    push(@rows, td($date) .
                td($time) .
                td({-align=>'right'}, sprintf('%d:%0.2d', $upmin, $upsec)) .
                td($filename));
}

print table({-border=>'1', -cellpadding=>'3'},Tr([@rows])); #, "\n" if ($rows[1]);

print p, "\n",
      submit(-name=>'_action_', -value=>"$REFRESH"), '&nbsp;', "\n",
      submit(-name=>'_action_', -value=>"$REMOVEALL"), '&nbsp;', "\n",
      end_form, "\n";

print end_html;