#!/usr/bin/perl -T
#
# PPP Remote Control: A Perl CGI script acting as remote control for pppd.
# Copyright (C) 2000 by Josef Drexler <jdrexler@julian.uwo.ca>
# Distributable under the terms of the GNU General Public License. For more
# information see the file COPYING which should have come with this file.
#
# Usage:
# ------
# Simply install in your cgi-bin directory and try it, possibly
# after changing the next few lines of configuration;
# ppp-rc is able to start any pppd connection listed in /etc/ppp/peers,
# list the active connections or stop those that it started (i.e. those
# run by the same user your web server is running as).

#
# ****** CONFIGURATION ******
#

$pppd = "/usr/sbin/pppd %supdetach call '%s'";
	# $pppd is the command line to be run for a new connection, where %s
	# will be the connection name.
	#
	# pppd should detach after establishing a network protocol and call
	# the selected ISP, with the options from /etc/ppp/peers/%s. Because
	# wvdial doesn't let pppd detach, it can't be used with this program.
	#
	# First %s is "debug " if the debug box is selected, or empty
	# otherwise, and the second %s is the connection name.
	#
	# For future compatibilty, please put "linkname <peername>" in the
	# peer configuration, where <peername> is the filename in
	# /etc/ppp/peers. This will be necessary for keeping track of
	# subscriptions.

#$pppd = "/usr/bin/sg dialout -c \'/usr/sbin/pppd %supdetach call '%s'\'";
	# You may need to use this if pppd isn't world executable but can be
	# run from e.g. the "dialout" group. The web server's UID must be a
	# member of the group and it can't have a password.
	# See gpasswd(1) for more information.

$peerlist = "/bin/ls -1 /etc/ppp/peers/*";
	# $peerlist is a command to return the list of possible
	# connections. It is mainly provided for compatibility with other
	# pppd calling mechanisms.

$peerpattern = ".*\/([^\/]+)";
	# regexp to extract the connection name from the above list
	# entries which don't match the pattern won't make it, for the rest
	# everything between the first set of parentheses will be the
	# name of the selection and the %s parameter in the $pppd command.
	# ".*\/([^\/]+)" cuts off all directory names and just leaves the
	# file name, which is a valid parameter for the pppd "call" option.


$pidfile = "/var/run/%s.pid";
	# $pidfile is where pppd stores its pid file, with %s being the
	# interface name. This is used to determine the time an interface
	# has been active, by looking at the pid file's ctime.

$killsignal = 15;	# 1 for HUP, 15 for TERM
	# $killsignal is the signal used to kill pppd processes when
	# stopping connections. Use TERM (15) because HUP (1) will restart
	# connections started with the "persist" or "demand" option and
	# KILL (9) won't allow for a clean exit.

# $showbytes is obsolete - use @statuscols instead

$successurl = "http://www.yahoo.com/";
#$successurl = "/";
	# $successurl is where clicking the "OK" button of a successful
	# connection will take you.  For most web servers and clients,
	# this needs to be an absolute URL.

$callmethod = 1;
	# $callmethod selects whether pppd should be run in the background
	# (though not detached until the interface is up) to show output as
	# soon as it arrives (1) or if ppp-rc should wait for pppd to 
	# return (0).

$shell = "/bin/sh";
	# The shell to be used to run various commands that need to be run

$shellpar = "-c";
	# Shell command to execute a command.

BEGIN { $useNetInterface = 0; };
	# If you have the Net::Interface perl module installed, set this to
	# 1 for better portability.  If you have configured the CPAN module,
	# try running  perl -MCPAN -e 'install Net::Interface'  to install
	# the Net::Interface module.  Read the CPAN docs for more info.
	#
	# Note: this *must* be in a BEGIN { } block because the module
	# is (or should be!) loaded at compile time.

$ifconfig = "/sbin/ifconfig";
	# $ifconfig is the path for the ifconfig executable, this will be
	# called if you haven't set $useNetInterface to 1.

$getPPPstatsmethod = 0;
	# ppp-rc needs to get data statistics for each interface. It can get
	# these from /proc/net/dev (0) or the pppstats program (1).  pppstats
	# will hopefully be more portable.

$procnetdev = "/proc/net/dev";
	# $procnetdev points to the file where device stat are available, if
	# $getPPPstatsmethod is set to 0.

$pppstats = '/usr/sbin/pppstats -a %s';
	# $pppstats points to the pppstats program, with %s being a placeholder
	# for the interface name.  This is used if $getPPPstatsmethod is 1.

#$uselinkname = 1;
	# Not used yet. Will be used for subscriber control.

$nmblookup = '/usr/bin/nmblookup -A';
	# Program to look up an SMB name, the IP address is appended to the
	# command. Output needs to be in the form
	#	NAME <nr> something GROUP otherstuff
	# When split at whitespace, the first field must be the machine name,
	# the second is <00> or the line is ignored, and the fourth is
	# <GROUP> for the line where NAME is the workgroup.

$havedebugbutton = 1;
	# Add a "debug" checkbox when starting a connection.  For this to
	# work, the following conditions must be met:
	#	1) The $pppd command has two %s placeholders. The first one
	#	   will be "debug " if this option is selected.
	#	2) The peer configuration file (in /etc/ppp/peers) calls
	#	   chat with something like this:
	#		connect '/bin/sh -c "/usr/sbin/chat $verbswitch \
	#			-Ssf /etc/ppp/mychat"'
	#	   The $verbswitch will contain "-v" if the debug box is
	#	   checked, to debug the modem commands and replies.

$statustype = 0;
	# Set whether the remote control is restricted to status only 
	# or if full control is given.
	#
	# 0: Allow full remote control, and status display can stop conn's
	# 1: Allow full remote control, but status can't stop connections
	# 2: Only status display, and no stopping of connections through ppp-rc
	#
	# For 0 and 1, the status-only display is invoked by appending
	# "?status=1" to the URL, e.g. ".../ppp-rc.cgi?status=1").
	# If set to 1 it doesn't prevent stopping because the URL can be
	# altered to remove the status-only display option.  If you want to
	# prevent this set it to 2 and have a separate script with this
	# variable set to 0 or 1, and restrict access to this script using
	# the web server's capabilities.

#@statuscols = ( 1,2, 12, 13 );
#@statuscols = ( 1, 2, 3.0, 3.1, 4.2, 3.3, 3.4, 5, 6, 6.1,
#	7, 7.1, 7.2, 8, 8.1, 8.2, 9.5, 10, 11, 12, 13.1, 13.2 );
#@statuscols = ( 1, 2, 3, 11.2, 12.2, 6, 7 );
@statuscols = ( 1, 3, 7, 8, 12.2, 12, 13.2, 13 );
	# This selects what information is shown in the connection information
	# table. It's a list of numbers, which determine what is shown in a
	# column.  The numbers are floating point numbers, with the integer
	# part selecting which data to show, and the optional fractional part
	# selects the data format.  If several numbers with the same integer
	# value follow each other, the corresponding table heading will
	# cover all columns.
	#
	# One of the numbers can be negative, indicating that the buttons
	# for stopping the connection will be added in that column. If no
	# negative number is present, the radio buttons will be in the first
	# column.
	#
	# This selection can be modified at runtime, by setting the "display"
	# variable in the CGI arguments, e.g.
	# http:/.../ppp-rc.cgi?display=3,8.2,12.2,13.2
	# You may have to encode the comma as %2c instead.
	#
	# 1: interface name (ppp0, ppp1 etc.)
	# 2: link name (from the pppd 'linkname' option)
	# 3: local address[1]
	# 4: remote address[1]
	# 5: pppd PID
	# 6: pppd process owner[2] (doesn't work yet)
	# 7: activation time/date[3]
	# 8: time active[4]
	# 9: started from (request source address/host/FQDN)[1] (not 
	#    implemeted yet)
	# 10: no. of subscribers (not implemented yet)
	# 11: list of subscribers[1] (not implemented yet)
	# 12: received data amount[5]
	# 13: sent data amount[5]
	#
	# Here is the list of display formats, which are chosen by the
	# fractional part of the number.  For example, "2.2" would display
	# the FQDN of the local ppp address, whereas "2.0" would just display
	# the local IP address.  The format "0" is default if none is given.
	#
	# Several decimals can be specified, and will be used in case one of
	# the display formats is unavailable or can't be determined. Example:
	# "2.321" will display the SMB Name if it's available, otherwise the
	# FQDN. If the FQDN can't be determined, the hostname will be used,
	# otherwise simply the IP (because there's always an implicit 0 at
	# the end)
	#
	# Possible formats:
	# [1] Network address formats
	# 0: IP address
	# 1: host name
	# 2: FQDN (FQDN = full qualified domain name)
	# 3: SMB Name
	# 4: SMB Name (SMB Workgroup), nmbclient must be installed
	#    For 3 and 4, nmbclient (from the Samba suite) must be installed.
	#    Note that you should only use these options for local systems,
	#    not for the remote IP (4), because your ISP will not appreciate
	#    the probing of its servers for SMB names.
	# 5: authenticated username (for "started by" and subscriber list)
	#
	# [2] Interface owner formats
	# 0: UID
	# 1: username
	#
	# [3] Activation time/date
	# 0: local time
	# 1: UTC
	# 2: raw time in seconds since start of the epoch
	#
	# [4] Time active, these decimals can be given:
	# 0: 3 significant figures, e.g. "2.61 hours"
	# 1: number of days, hours, minutes and seconds, e.g. "3d4h1m34s"
	# 2: number of seconds
	#
	# [5] Data amounts
	# 0: number of packets (default)
	# 1: number of bytes (only available for 2.1.something or higher 
	#    kernels or with the pppstats program - see $pppstats above)
	# 2: number of bytes in 3 significant figures with KB, MB, GB etc.
	#

#
# ****** END OF CONFIGURATION ******
#
# No user servicable parts below...
#
#
# General idea about how it operates:
#
# ppp-rc implements both the GET and POST methods.  GET is used for the
# initial control page, and can also display a status-only page (call it
# with .../ppp-rc.cgi?status=1). POST is used to start and stop connections.
# This makes it easier to give different access authorities for each method
# using the web server's capabilities. A sample .htaccess file for the
# Apache server is included in the distribution.
#
# Many thanks go to
#	Erwan Mas <erwan@mas.nom.fr> for bugfixes and contributing the
#		start/stop light in the contrib/ directory as well as
#		a nice suggestion for the web server config
#	Eduard Llull <ellull@imagoediciones.com> for bugfixes
#

#
# *********************************************************************
#
#          Main Program
#
# *********************************************************************
#


require 5.001;

$version = "0.7.1";
$copyright = "Copyright &copy; 2000 by Josef Drexler";

use CGI;

BEGIN {
#	for avoiding denial of service attacks with huge POSTs
	$CGI::POST_MAX=1024 * 100;  # max 100K posts
	$CGI::DISABLE_UPLOADS = 1;  # no uploads
}

# load the Net::Interface module if requested by the configuration above
# (this is done at compilation time, not runtime)
BEGIN {
	if ($useNetInterface) {
		require Net::Interface;
		import Net::Interface;
	}
}

$q = new CGI;

# Redirection gets a special handling because it needs a different header
if (defined $q->param('action') && ($q->param('action') eq "redirect") ) {
	print &redirect($q->param('RedirectURL'));
	exit(0);
}

$_=$q->param('display');
if (defined $_) {
	die "Invalid display parameter $1***" if /([^0-9\-,\.]+)/;
	/(.*)/;					# we can untaint it, there are
	my $newcols = '@statuscols = ('.$1.')';	# no dangerous chars in it
	eval $newcols;
}

# All others use the standard header
print	$q->header,
	$q->start_html('PPP Remote Control'),"\n",
	$q->comment("ppp-rc version $version $copyright"),
	"\n";

$headerdisplayed = 1;

METHOD: for($q->request_method()) {
    /^GET/ && do {
	# GET is either Control, Status or Redirect
	if(defined $q->param('status') || ($statustype == 2)){
		print &statuspage;
	}else{
		print &controlpage;
	}
	last METHOD;
    };
    /^POST/ && do {
	# POST can be starting or stopping
	POSTACTION: for($q->param('action')) {
		/^start/ && do { &StartPage; last POSTACTION; };
		/^stop/  && do { &StopPage;  last POSTACTION; };
		die "Invalid action \"".$q->param('action')."\".***";
	};
	last METHOD;
    };
    die "Invalid method \"".$q->request_method()."\".***";
};
print $q->end_html;

exit(0);

#
# *********************************************************************
#
#          HTML Page Construction
#
# *********************************************************************
#


#
# Sends a 301 Moved output and redirects to the selected page
#
sub redirect{
	return	$q->redirect(@_),
		$q->start_html(	-title=>'301 Moved Permanently' ),
		$q->h1('Moved Permanently'),
		"The document has moved ",
		$q->a({href=>@_},"here"),
		$q->end_html;
}
#
# Gives a list of active connections for  the separate status-only page
# (URL .../ppp-rc.cgi?status=1)
#
sub statuspage{
	return	$q->comment("StatusPage"),
		$q->h1("The following connections are active:"),
		&activeconnections(!$statustype),
		$q->referer()
			? ($q->start_form(-method=>'GET',
					      -action=>$q->referer()),
			   $q->submit(-name=>"Go",-value=>"Back"),
			   $q->end_form)
			: '',
		$q->start_form(-method=>"GET"),
		&keepoptions,
	 	$q->submit(-name=>"Go",-value=>"Refresh"),
		$q->end_form,
		$q->comment("/StatusPage");
}
#
# The control page to start, list and stop connections. Displayed if a
# GET with no options was requested.
#
sub controlpage{
	return &controlpage_top,&controlpage_middle,&controlpage_bottom;
}
sub controlpage_top{
	return	$q->comment("ControlPage"),
		$q->h1("Remote Control options:"),
		$q->h2("Start new connection"),
}
sub controlpage_middle{
	return	&startconnections,
		$q->h2("Connection information");
}
sub controlpage_bottom{
	return	&activeconnections(1),
		$q->hr({-width=>'100%'}),
		$q->start_form(-method=>"GET"),
		&keepoptions,
	 	$q->submit(-name=>"Go",-value=>"Refresh"),
		$q->end_form,
		$q->comment("/ControlPage");
}
#
# Called when the "new connection" button is pressed
#
sub StartPage{
	print $q->comment("StartPage");
	my $ISP=$q->param('ISP');
	if ( !$ISP || ($ISP eq "Select Connection")){
		print	&controlpage_top,
			$q->p("Please select a connection."),
			&controlpage_middle,
			&controlpage_bottom;
		return;
	}

	$| = 1;		# Set autoflush for STDOUT
	my $dodebug="";
	my $verbswitch="";
	if (defined $q->param('Debug')) { 
		$dodebug="debug "; 
		$verbswitch="export verbswitch='-v';";
	};
	my $command = $verbswitch . sprintf($pppd, $dodebug, $ISP);
	print $q->h1("Starting Connection \"$ISP\""),
	      $q->p("Command line: ",$q->blockquote($q->tt($command)));
	      
	$exitcode = &run_pppd($command);
	print 	"The exit code was $exitcode, which means ",
		"\"$exittext[$exitcode]\".\n";
		
# NOW, find PID and ppp device from /var/run/ppp-linkname.pid
# at the same time look if interfaces came up/come up
#	my $linknamefile = sprintf($pidfile, 'ppp-' . $ISP);
#	print "I'm checking $linknamefile now!";
#	XXXX Subscriber control
	
	print 	$q->p(),
		&start_donebuttons,
		$q->comment("/StartPage");
}

#
# Run pppd, capture output and display it
#
sub run_pppd{
	my $command = shift;

	# shown only if there is any output
	my $transcriptstart = "Session transcript:<BR>\n<BLOCKQUOTE><PRE>";
	my $transcriptend = "</PRE></BLOCKQUOTE>\n<P>";
	if ($callmethod) {
		my $pid = open(PPPDOUTPUT, "-|");	# open pipe to pppd
		unless (defined $pid) {
			die "An error has occured while trying to fork.***";
		}
		if ($pid) {	# parent (remains ppp-rc)
			while(<PPPDOUTPUT>) {
				print $transcriptstart, $q->escapeHTML($_);
				$transcriptstart="";
			}
			close(PPPDOUTPUT);
			if (!$transcriptstart) {
				print "$transcriptend";
			}
		} else {	# child to-be-pppd
			open(STDERR, ">&STDOUT");	# redirect shell stderr
			{ exec $shell, $shellpar, $command };
			print "$shell: $!";	# didn't work, show error msg
			exit(1);
		}
		# waitpid($pid,0);	# WHY don't I need this??
	} else {
		if (my $result = `$command`) {
			print	$transcriptstart,
				$q->escapeHTML($result),
				$transcriptend;
		}
	}
	return $exitcode = $? >> 8;
}
#
# Buttons at bottom of start page
#
sub start_donebuttons{
	return	$q->table(
			$q->Tr(
				$q->td(	$q->start_form(-method=>"POST"),
					$q->hidden(-name=>"RedirectURL",
						   -value=>$successurl),
					&hidden_override("action","redirect"),
					$q->submit(-value=>"OK"),
					$q->end_form
				),
				$q->td(	$q->start_form(-method=>"POST"),
					$q->hidden(-name=>"ISP"),
					&hidden_override("action","start"),
					&keepoptions,
					$q->submit(-value=>"Retry"),
					$q->end_form
				),
				$q->td(	$q->start_form(-method=>"GET"),
					$q->submit(-value=>"Back"),
					$q->end_form
				)
			)
		);
}
#
# Called to stop the selected connection
#
sub StopPage{
	$| = 1;		# Set autoflush
	print $q->comment("StopPage");
	my $iface=$q->param('interface');
	if (!$iface){
		print	&controlpage_top,
			&controlpage_middle,
			$q->p("Please select a connection."),
			&controlpage_bottom,
			$q->comment("/StopPage");
		return;
	}
	print	&controlpage_top,
		&controlpage_middle;
	my $filename = sprintf($pidfile,$iface);
	open(PIDFILE, $filename) || print "Connection $iface not active!\n",
					&controlpage_middle,
					&controlpage_bottom,
					$q->comment("/StopPage");
	
	my $pid = 0 + <PIDFILE>;	# read pid and force it to be integer
	close(PIDFILE);

	# untaint the $pid
	if ($pid =~ /^([0-9]+)$/) {
		$pid = $1;
	} else {
		die "\$pid is tainted, contains '$pid'.***";
	}

	print $q->p("Disconnecting $iface, PID $pid.\n");
	my $result = kill $killsignal, $pid;
	if ($result){
		print $q->p("Waiting for disconnection.\n");
		my $waiting = 10;	# 10 second timeout
		while ($waiting-- && -e $filename) { sleep 1; }
		if (-e $filename) {print $q->p("Failed! (Timout)\n")};
	}else{
		print $q->p("Failed: $! (Wrong uid?)\n");
	}
	print	&controlpage_bottom,
		$q->comment("/StopPage");
}
#
# Get a list of the connections
#
sub getpeers{
	my @connections = ();
	my @ispentries = `$peerlist`;
	die "$peerlist: no entries or command not found.***" if $?;

	foreach (@ispentries) {
		chomp;
		push @connections,$1 if /$peerpattern/;
	}
	return @connections;
}
#
# Displays the form from which a connection can be started, by listing
# the entries in $peerlist.
#
sub startconnections{
	my @ispentries = &getpeers;
	# if there is more than one selection, insert title before them
	if ($#ispentries){
		unshift @ispentries,'Select Connection';
		$q->param(-name=>'selectstart',-value=>$ispentries[0]) 
			unless $q->param('selectstart');
	}
	# and return the page
	return	$q->comment("ShowStartConnections"),
		$q->start_form(-method=>"POST"),
		$q->popup_menu(	-name=>'ISP',
				-values=>\@ispentries,
				-default=>$q->param('selectstart')),
		&keepoptions,
		&hidden_override("action","start"),
		$q->submit(-name=>"Go",-value=>"New Connection"),"\n",
		$havedebugbutton?
			$q->checkbox_group(-name=>"Debug",-value=>"Debug"):"",
		$q->end_form,
		$q->comment("/ShowStartConnections");
}
#
# Shows a table of active connections, and the "Stop connection" button
# Parameter determines whether the connections can be stopped (1) or not (0).
#
sub activeconnections{
	my $stoppable = shift;
	my @colnames = ( '', 'Interface', 'Link Name',  'Local', 'Remote',
		'PID', 'Owner', 'Activated', 'Active for', 'Initiated by',
		'Subscribers', 'Subscriber List', 'Received', 'Sent' );
	
	my $heading = ();
	my $lasttype = 255;
	my $repeat = 0;
	my @rows = ();
	my @thisrow = ();
	
	foreach (@statuscols) {

		if (int(abs) == $lasttype) {	# same heading multiple cols
			$repeat++;
		} else {
			if ($heading) {
				push @thisrow,$q->th(
					$repeat>1?{-colspan=>$repeat}:{},
					$heading);
			}
			$repeat = 1;
			$lasttype = int(abs);
			$heading = $colnames[int(abs)];
		}
	}

	if ($heading) {
		push @thisrow,$q->th($repeat>1?{-colspan=>$repeat}:{},$heading);
	}
	push @rows,$q->Tr(@thisrow);

	&EnumeratePPPInterfaces;
	foreach (@interface) {
		&GetInterfaceProperties($_);
		push @rows,&InterfaceLine($stoppable);
	}

	my @list;
	if ($#interface < 0) {		# no connections
		@list = $q->p($q->i("No PPP interfaces active"));
	} else {			# active connections
		@list = $q->table({border=>undef},@rows);
		if ($stoppable) {
			@list =	($q->start_form(-method=>"POST"),
				 @list,
				 $q->br,
				 &keepoptions,
				 &hidden_override('action','stop'),
				 $q->submit(-name=>'Go',
					-value=>'Stop the selected connection'),
				 $q->end_form())
		}
	}

	return	$q->comment("ShowActiveConnections"),
		@list,
		$q->comment("/ShowActiveConnections");
}
#
# Overrides the value of a CGI option and places a hidden form entry
# Can't use $q->hidden() because that will always keep the value from the option
#
sub hidden_override{
	return $q->input({-type=>"hidden",-name=>shift,-value=>shift});
}
#
# Defines hidden inputs in a form to keep options between GETs and POSTs
#
sub keepoptions{
	my(@returnlist) = ();
	foreach $option (@keepoptions){
		if ($q->param($option)){
			push @returnlist,
				@_,$q->hidden(-name=>$option),"\n";
		}
	}
	return @returnlist;
}

#
# *********************************************************************
#
#          Functions for filling in the interface lines
#
# *********************************************************************
#

# 
# Return decimals in order of appearance
# 
sub decimals{
	my @parts=split /\./,sprintf("%.10f",@_);
	return split '',$parts[1],0;
}
	
#
# Show one row with one interface for the connection table
# Parameter determines whether the connections can be stopped (1) or not (0).
#
sub InterfaceLine{
	my $stoppable=shift;
	my $default=$q->param('selectstop');
	$default="-" unless $default;

	# List of subs to call for each column.
	# content: simply return the content of the ifaceprop key
	# netaddr: format content as network address[1]
	# owner: format content as owner[2]
	# datestamp: format content as datestampt[3]
	# period: format content as time period[4]
	# dataamount: format content as amount of data[5]
	my @handlers = \(&content,  &content, &content, &netaddr, &netaddr,
		&content, &owner, &datestamp, &period, &netaddr, &content,
		&netaddr, &dataamount, &dataamount);

	# Which entries in the ifaceprop hash to display for each column
	my @params = ('none', 'name', 'link name',  'inet addr', 'P-t-P',
		'PID', 'pppd owner', 'PID ctime', 'time active', 'Initiator',
		'Subscriber No', 'Subscriber List', 'RX', 'TX');
	
	my @output=();

	my $buttoncol = -1;	# first column by default (special value)

	# find column for stop buttons
	foreach (@statuscols) {
		if ($_ < 0) {
			$buttoncol = abs;
			last;
		}
	}
	# remove radio button if connection isn't supposed to be stoppable
	$buttoncol = -3 unless $stoppable;

	# actual output
	foreach (@statuscols) {
		my $handler = $handlers[int(abs)];
		my $param = $params[int(abs)];
		my @dec = &decimals(abs);
		my $content;

		do {
			$content = &$handler($param,shift(@dec));
		} while (!$content && ($#dec >= 0) );
		if (!$content) {
			$content="";
		}
		if ( (abs == $buttoncol) || ($buttoncol == -1) ) {
			push @output,
				$q->td(
					$q->radio_group(-name=>"interface",
						-values=>$content,
						-default=>$default),
				);
			$buttoncol = -2;
		} else {
			push @output,$q->td($content);
		}
	}
	return $q->Tr(@output);
}
#
# Output functions
#
# Easy access to the data
sub get{
	my $param = shift;
	return $ifaceprop{$param},@_;
}
# Display unformatted content
sub content{
	my $param=shift;
	return $ifaceprop{$param};
}
# Display a network address
sub netaddr{
	my ($IP,$format) = &get(@_);
	if ($format == 0) {
		return $IP;
	}
	if ($format < 3) {		# hostname based
		my $addr = pack('C4',split(/\./,$IP));
		@hostinfo = gethostbyaddr($addr,2);
	
		if ($format == 1) {		# hostname
			@parts = split(/\./,$hostinfo[0]);
			return $parts[0];
		} elsif ($format == 2) {	# FQDN
			return $hostinfo[0];
		}
	} elsif ($format < 5) {	# SMB based
		my @nmbdata = `$nmblookup $IP`;
		my ($machine,$workgroup) = ();
		foreach (@nmbdata) {
			my @fields = split;
			if ( (defined $fields[1]) && ($fields[1] eq '<00>') ) {
				if ($fields[3] eq '<GROUP>') {
					$workgroup = $fields[0];
				} else {
					$machine = $fields[0];
				}
			}
		}
		if ($format == 3) {
			return $machine;
		} else {
			return "$machine ($workgroup)";
		}
	}
	return;
}
# Display a user ID
sub owner{
	my ($owner,$format) = &get(@_);
	if ($format == 1) {
		$owner = getpwuid($owner);
	}
	return $owner;
}
# Display a datestamp
sub datestamp{
	my ($seconds,$format,$result) = &get(@_);
	if ($format == 2) {
		$result=$seconds;
	} elsif ($format == 1) {
		$result=gmtime($seconds);
	} else {
		$result=localtime($seconds);
	}
	return $result;
}
# Display a time period
sub period{
	my ($seconds,$format) = &get(@_);
	if ($format == 2) {
		return $seconds."s";
	}

	my @timeunits = (   1,  60, 3600, 86400, 31556736 );
	my @timenames = ( 's', 'm',  'h',   'd',      'y' );

	if ($format == 1) {
		use integer;
		my $activetext = "";
		my $remain = $seconds;
		while ($#timeunits >= 0) {
			local $_ = pop @timeunits;
			my $thisname = pop(@timenames);
			my $value = $remain / $_;
			$remain -= $value * $_;
			if ($value || $activetext){
				$activetext=$activetext.$value.$thisname.' ';
			}
		}
		return $activetext;
	}

	my $unit=1;
	my $thisname='';
	my $unittext="";
	foreach (@timeunits) {
		$thisname = shift(@timenames);
		if ($seconds >= $_) {
			$unit=$_;
			$unittext = $thisname;
		}
	}
	return &sigfig($seconds/$unit, 3).$unittext;
}
# Display an amount of data
sub dataamount{
	my $format = $_[1];
	my $dataunit = $format ? " bytes" : " packets"; 
	$_[0] .= $dataunit;
	my ($bytes,$unit,$unittext) = (&content(shift),1,"");

	if ($format == 2) {		# bytes in 3 sig figs
		my @unitnames = ( " B", " KB", " MB", " GB", " TB" );
		my $thisunit=1;
		foreach (@unitnames) {
			if ($bytes >= $thisunit) {
				$unit=$thisunit;
				$unittext = $_;
			}
			$thisunit *= 1024;
		}
		return &sigfig($bytes/$unit, 3).$unittext;
	} else {
		return $bytes.$dataunit;
	}
}
#
# Returns string with number>1 rounded to the given number of sig.figs.
#
sub sigfig{
	my ($value,$sigfig,$predec,$tempval) = (shift,shift,0);
	$tempval=$value;
	while ($tempval >= 1) {
		$predec++;
		$tempval/=10;
	}
	return sprintf("%*.*f",$predec,$sigfig-$predec,$value);
};

#
# *********************************************************************
#
#          Network Interface functions
#
# *********************************************************************
#

# 
# Get interface info using the Net::Interface module, or 
# 'ifconfig', enumerate all point-to-point interfaces
# (and store temporary data about their properties)
#
sub EnumeratePPPInterfaces{
	@interface = ();
	@ifacedata = ();
	if ($useNetInterface) {
		my @ifs = sort {$a->name() cmp $b->name()} 
				Net::Interface->interfaces();
		foreach (@ifs) {
			if ($_->flags & $_->IFF_POINTOPOINT) {
				push @interface,$_->name();
				$ifacedata{$_->name()} = $_;
			}
		}
	} else {
		my @ifconfigresult = `$ifconfig`;
		push @ifconfigresult,"\n";

		my $ifline = "";
		foreach $line (@ifconfigresult){
			if ($line eq "\n"){
				$ifline =~ tr/\\\n/ /;
				my @iface = split(/ /, $ifline, 2);
				if (defined $iface[1] && 
				    ($iface[1] =~ /POINTOPOINT/)) {
					push @interface,$iface[0];
					$ifacedata{$iface[0]} = $iface[1];
				}
				$ifline = "";
			} else {
				$ifline = $ifline . $line;
			}
		}
	}
}

#
# Get the properties of the interface, and store them in the
# hash %ifaceprop (used by InterfaceLine)
#
sub GetInterfaceProperties{
	my $iface = shift;
	$ifaceprop{"name"} = $iface;
	if ($useNetInterface) {
		$ifaceprop{'inet addr'}=
			join(".",unpack('C4',$ifacedata{$iface}->address));
		$ifaceprop{'P-t-P'}=
			join(".",unpack('C4',$ifacedata{$iface}->destination));
		&GetDataInfo($iface);
	} else {
		#
		# Parse the ifconfig output
		#
		my @pairs = split(/ /, $ifacedata{$iface});

		my $lastsingle = "";
		foreach (@pairs){
			my ($name, $value) = split(/:/);
			if (!$value) {
				$lastsingle = $name;
			} else {
				if ($lastsingle) {
					$name = $lastsingle . " " . $name;
					$lastsingle = "";
				}
				$ifaceprop{$name} = $value;
			}
		}
		&GetDataInfo($iface);
	}
	#
	# Get active time
	# selected interface, from the pppd pid file
	#
	my $filename=sprintf($pidfile,$iface);
	my @pidstat = stat($filename);
	$ifaceprop{"pppd owner"} = $pidstat[4];
	$ifaceprop{"PID ctime"} = $pidstat[10];
	$ifaceprop{"time active"} = time - $pidstat[10];
	open(PIDFILE, $filename) || return;
	$ifaceprop{"PID"} = 0 + <PIDFILE>;
	close(PIDFILE);
}
#
# Get extended interface info, like bytes/packets transferred,
# either from the /proc FS or from the pppstats program
#
sub GetDataInfo{
	my $iface = $_;
	if ($getPPPstatsmethod) {	# use pppstats program
		my $command = sprintf($pppstats, $iface);
		my ($headingline,$statsline) = `$command`;
		my @headings = split ' ',$headingline;
		my @stats = split ' ',$statsline;
		my $isout = 0;
		foreach (@headings) {
			my $stat = shift(@stats);
			if (/IN/) {	# incoming data, first bytes
				$ifaceprop{"RX bytes"} = $stat;
			} elsif (/OUT/) {	# outgoing
				$ifaceprop{"TX bytes"} = $stat;
				$isout=1;
			} elsif (/PACK/) {	# packets, either in or out
				if ($isout) {
					$ifaceprop{"TX packets"} = $stat;
				} else {
					$ifaceprop{"RX packets"} = $stat;
				}
			}
		}
	} else {		# get data from /proc/net/dev
		$ifaceprop{"RX bytes"} = "n/a";
		$ifaceprop{"TX bytes"} = "n/a";
		open(PROCINFO, $procnetdev) || return;
		while (<PROCINFO>) {
			if ($_ !~ /\|/){	# disard header line(s)
				$_ =~ tr/:/ /;
				@entries = split;
				if ($entries[0] eq $iface) {
					if ($#entries == 16){	
						# 2.2.x kernel only!
						$ifaceprop{"RX bytes"} = 
							$entries[1];
						$ifaceprop{"TX bytes"} =
							$entries[9];
						$ifaceprop{"RX packets"} =
							$entries[2];
						$ifaceprop{"TX packets"} =
							$entries[10];
					}
				}
			}
		}
		close(PROCINFO);
	}
}

#
# *********************************************************************
#
#	Supplemental functions
#
# *********************************************************************
#

#
# Display an error/"die" text in a CGI compatible manner
#
sub cgierror{
$q=new CGI("") unless defined $q;
$_=shift;

# "normal" error messages should be displayed with the file name and line number
s/\*{3}.*$//;	# those are marked by "***", cut this and the rest off

if (! /^!/) { # escape HTML if not already done so explicitly (i.e. if
	$_ = $q->escapeHTML($_);	# pattern starts with "!")
}
print   $headerdisplayed	# make sure only one CGI header is produced
		? $q->h1('Software error')
		: ($q->header('text/html','400 Software error'),
		   $q->start_html('Software error').
		   $q->h1('Software error')),
	$q->p($_),
	$q->end_html,"\n";
exit(1);
}

#
# Initialization
#
BEGIN {	# hook "die" signal
	$headerdisplayed = 0;
	$SIG{__DIE__}=\&cgierror;

	# remove everything from PATH for security reasons.
	# all programs must be given with explicit path
	$ENV{'PATH'} = ''; 

	# These FORM options are kept across sessions
	@keepoptions = (
	    "selectstart",
	    "selectstop",
	    "display",
	    "status",
	);

	# verbose exit codes of pppd, valid for pppd >= 2.3.8
	@exittext=(
		"Connection successfully established",
		"Fatal error",
		"Error in options",
		"Pppd not suid root nor started by root",
		"Kernel does not support PPP",
		"Terminated by SIGINT, SIGTERM or SIGHUP",
		"The device could not be locked",
		"The device could not be openend",
		"The connect script failed",
		"The pty command could not be run",
		"PPP negotiation failed",
		"The peer failed or refused to authenticate itself",
		"The link was terminated because it was idle",
		"The link was terminated because the connect time limit was reached",
		"Callback was negotiated and an incoming call should arrive shortly",
		"The link was terminated because the peer was not responding to echo requests",
		"The link was terminated by the modem hanging up",
		"PPP negotiation failed because serial loopback was detected",
		"The init script failed",
		"We failed to authenticate ourselves (check the passwords)",
	);
}