#!/usr/bin/perl -wT
#this is a combination of jeff's previous pptp scripts
#functions:
# setup - configures tunnel servers and chap-secrets
# start - brings up a tunnel
# stop  - brings down a tunnel
#
# chkconfig: - 90 10
# description: cleanly brings down the tunnel when changing runlevels.
#
### BEGIN INIT INFO
# Provides: pptp
# Required-Start: network
# Required-Stop: network
# Default-Start: 
# Default-Stop: 0 1 2 3 4 5 6
# Description: PPTP based VPN
### END INIT INFO
# $Id: pptp-command,v 1.7 2001/04/23 03:04:53 scott Exp $

#######
# Data
#
# the regexp for the list of characters that are unsafe
# to put inside a system() or ``
# it is built by saying everything but known safe characters
# anyone want to make bets on if this holds true for i18n'ed systems?
my $safe_set  = '-A-Za-z0-9\s\._\/:';
my $unsafe_re = "[^$safe_set]";
my $safe_re   = "[$safe_set]*";

#
# pppdir - the directory containing the ppp config files
#
my $pppdir = $ENV{"PPPDIR"};
die "Stop screwing with me and set PPPDIR to something reasonable\n" if defined $pppdir && $pppdir =~ /$unsafe_re/o;
$pppdir = "/etc/ppp" unless defined $pppdir;

#
# pptpdir - the directory containing the pptp drop-in config files
#
my $pptpdir = $ENV{"PPTPDIR"};
die "Stop screwing with me and set PPTPDIR to something reasonable\n" if defined $pptpdir && $pptpdir =~ /$unsafe_re/o;
$pptpdir = "/etc/pptp.d" unless defined $pptpdir;

#
# chap_secrets - the full path to the the CHAP
#	(Challenge/Handshake Authentication Protocol) secrets file
#
my $chap_secrets = "$pppdir/chap-secrets";

#
# tunnel_dir - the directory containing tunnel config files
#
my $tunnel_dir = "$pppdir/peers";

#
# subsys_dir - the place "rc" looks to see if a servics is started
#              before it runs the K* scripts
my $subsys_dir = "/var/lock/subsys";

#
# The resolv.confs...
#
my $resolv = "/etc/resolv.conf";
my $resolv_pptp = "$resolv.pptp";
my $resolv_real = "$resolv.real";

#
# clean up the path since this is run as root.
$ENV{PATH} = "/bin:/usr/bin:/usr/sbin";
delete $ENV{BASH_ENV};
delete $ENV{IFS};

sub usage() {
	print "usage: $0 [setup|stop|start [tunnel]]\n";
	print "all options must be specified to run non-interactively\n";
	exit 1;
}

#######
#first some support functions that are used everywhere
#
#yesno <prompt>
#
# Ask the user <prompt> and return true for yes, false for no
#
sub yesno($) {
	my $prompt = $_[0];
	while(1) {
		print "\n$prompt [Y/n]:";
		my $choice = <STDIN>;
		chomp $choice;
		return 1 if $choice eq "" || $choice =~ /[Yy]/;
		return 0 if $choice =~ /[Nn]/;
		print "\nI don't understand '$choice', please try again...\n";
	}
}

#QueryUser <prompt> <default>
#
# Ask the user <prompt> and return the answer, <default> if cr
#
sub QueryUser($$) {
	my ($prompt, $default) = @_;
	
	print "$prompt";
	print " [$default]" if defined $default;
	print ": ";
	my $answer = <STDIN>;
	chomp $answer;
	$answer = $default if $answer eq "" and defined $default;
	return $answer;
}

#ConfiguredTunnels
#
# Returns a list of configured tunnels
#
sub ConfiguredTunnels() {
	my @tunnels = ();
	if( -d "$tunnel_dir" ) {
		foreach my $f (`cd $tunnel_dir; ls`) {
			chomp $f;
			next if $f eq "__default";
			my $p = "$tunnel_dir/$f";
			if( $p !~ /^($safe_re)$/o ) {
				print "Unsafe characters in tunnel name $p\n";
				next;
			}
			$p = $1;
			push @tunnels, $f if -f $p and `grep '# PPTP' $p`;
		}
	}
	return @tunnels;
}

#bselect
#
# a rough equilivent of the bourne shell's select
sub bselect($@) {
	my $prompt = shift;
	my @choices = @_;
	for my $i (0..$#choices) {
		print $i+1 .".) $choices[$i]\n";
	}
	my $reply = QueryUser $prompt, undef;
	return $reply;
}



#SelectTunnel - interactive
#
# Prints $_[0] as a prompt and returns the choice.
#
sub SelectTunnel($) {
	my $tunnel = "";
	my @tunnels = ConfiguredTunnels;
	while($tunnel eq "") {
		$tunnel = bselect $_[0], @tunnels;
	}
	return $tunnels[$tunnel - 1] if $tunnel =~ /^\d+$/;
	return $tunnel if grep {/$tunnel/} @tunnels;
	return "";
}

#AddTunnel <name> <ip> <local> <remote>
#
# Adds a new tunnel with name <name>, server ip address <ip>,
# and using the CHAP secret determined by local name <local> and remote
# name <remote>.
sub AddTunnel($$$$@) {
	my ($name, $ip, $local, $remote, @routes) = @_;

	if( -f "$tunnel_dir/$name") {
		print "ERROR!  Peer $name already exists!\n";
		return;
	}

	open(PEER, ">$tunnel_dir/$name") 
	or die "can't open $tunnel_dir/$name for writing: $!";

	print PEER 
"#
# PPTP Tunnel configuration for tunnel $name
# Server IP: $ip\n";

	foreach my $r (@routes) {
		print PEER "# Route: $r\n";
	}

	print PEER
"#

# 
# Tags for CHAP secret selection
#
name $local
remotename $remote

#
# Include the main PPTP configuration file
#
file $pppdir/options.pptp

";

	close(PEER) or die "can't close $tunnel_dir/$name: $!";
	print "Added tunnel $name\n";
}

#DelTunnel <name>
#
# Deletes the tunnel named <name>
#
sub DelTunnel($) {
	my $name = $_[0];
	return if(!defined $name || $name eq "");
	if( ! -f "$tunnel_dir/$name" ) {
		print "ERROR! Peer $name does not exist!\n";
		return;
	}
	# $name has to be clean because it passed the -f test
	# and it's not being sent to a shell.  But -T doesn't know that.
	$name =~ /^(.*)$/o;
	$name =$1;
	unlink "$tunnel_dir/$name";
	print "Removed tunnel $name\n";
}

#BreakSymlink <file>
#
# If <file> is a symlink 
#	1. break the link
#	2. copy the contents of the file pointed to do <file>
#
sub BreakSymlink($) {
	my $file = shift;
	if( -l "$file" ) {
		my $link = readlink "$file";
		$link = "$1/$link" if $file =~ m,(.*)/[^/], and not $link =~ m,^/,;
		print "Breaking symlink $file -> $link\n";
		unlink "$file";
		die "$file pointed at a strangely named file\n" if $link !~ /^($safe_re)$/;
		$link = $1;
		`cp $link $file`;
	}
}

#Rotate <target> <new> <old>
#
# Rotates config files.  
#
#   <target> - full path of the config file 
#   <new>	- full path of the file being rotated in
#   <old>	- expected contents of the file being rotated out
#
# Example: 
#   Rotate /etc/resolv.conf, /etc/resolv.conf.pptp, /etc/resolv.conf.real
#
sub Rotate($$$) {
	my ($target, $new, $old) = @_;

	return undef unless -f $new && -f $old;
	my $diff = `diff $target $new`;
	chomp $diff;
	return 1 if $diff eq "";
	$diff = `diff $target $old`;
	chomp $diff;
	if($diff ne "") {
		print "WARNING: $new not installed\n";
		print "	$target does not match $old\n";
		return undef;
	}
	`ln -sf $new $target`;
	print "Installed $new as $target\n";
	return;
}


#AddCHAP - interactive
#
# Prompts for parameters and adds a CHAP secret
#
sub AddCHAP() {
	print
	"Add a NEW CHAP secret.

NOTE: Any backslashes (\\) must be doubled (\\\\).

Local Name:

This is the 'local' identifier for CHAP authentication.
 
NOTE: If the server is a Windows NT machine, the local name
	  should be your Windows NT username including domain.
	  For example:

		  domain\\\\username
 
";
	my $local = QueryUser "Local Name", undef;

	print
	"
Remote Name:

This is the 'remote' identifier for CHAP authentication.
In most cases, this can be left as the default. If must be
set if you have multiple CHAP secrets with the same local name
and different passwords. Just press ENTER to keep the default.

";
	my $remote = QueryUser "Remote Name", "PPTP";

	print
	"
Password:

This is the password or CHAP secret for the account specified. The
password will not be echoed.

";
	# Get the password without echoing
	`stty -echo`;
	my $pass = QueryUser "Password", undef;
	`stty echo`;

	open(CHAP, ">>$chap_secrets") or die ("couldn't open $chap_secrets: $!");
	print "\nAdding secret $local $remote *****\n\n";
	print CHAP "$local\t$remote\t$pass\n";
	print CHAP "$remote\t$local\t$pass\n";
	close(CHAP) or die ("couldn't close $chap_secrets: $!");
	chmod 0600, $chap_secrets;
} # /AddCHAP()

#AddPPTP - interactive
#
# Add a new PPTP tunnel configuration
#
sub AddPPTP() {
	my ($name, $ip, $local, $remote);
	print "\nAdd a NEW PPTP Tunnel.\n\n";
	my @configs = keys %pptp_servers;
	my $choice = bselect "Which configuration would you like to use?", 
	@configs, "Other";
	my @routes;

	if($choice == @configs+1) {
		$name = QueryUser "Tunnel Name", undef;
		$ip = QueryUser "Server IP", undef;
		print "What route(s) would you like to add when the tunnel comes up?\n";
		print "This is usually a route to your internal network behind the PPTP server.\n";
		print "You can use TUNNEL_DEV and DEF_GW as in /etc/pptp.d/ config file\n";
		print "TUNNEL_DEV is replaced by the device of the tunnel interface.\n";
		print "DEF_GW is replaced by the existing default gateway.\n";
		print "The syntax to use is the same as the route(8) command.\n";
		print "Enter a blank line to stop.\n";
		while (1) {
			my $route = QueryUser "route", undef;
			last unless defined $route;
			last if $route eq "";
			if($route =~ /$unsafe_re/o) {
				print "$route contains unsafe characters.  discarded.\n";
				next;
			}
			push @routes, $route;
		}
	} else {
		$name = $configs[$choice-1];
		$ip = $pptp_servers{$configs[$choice-1]}->{"ip"};
		@routes = @{$pptp_servers{$configs[$choice-1]}->{"routes"}};
	}

	print
	"Local Name and Remote Name should match a configured CHAP secret.
Local Name is probably your NT domain\\username.
NOTE: Any backslashes (\\) must be doubled (\\\\).

";

	$local = QueryUser "Local Name", undef;
	$remote = QueryUser "Remote Name", "PPTP";

	print "Adding $name - $ip - $local - $remote\n";

	AddTunnel $name, $ip, $local, $remote, @routes;
}

sub ConfigureResolv() {
	if(yesno "Use a PPTP-specific resolv.conf during tunnel connections?") {
		if( -f $resolv_pptp ) {
			print "$resolv_pptp exists.\n";
			if(! yesno "Do you want to use the existing $resolv_pptp?") {
				print "Renaming $resolv_pptp --> $resolv_pptp.orig...\n";
				rename $resolv_pptp, "$resolv_pptp.orig" 
					or die "couldn't rename $resolv_pptp: $!";
			}
		}
		if(! -f $resolv_pptp) {
			my @configs = keys %dns_servers;
			my $choice = bselect "Which configuration do you want to use?", @configs, "Other";
			my (@addresses, $search);

			if($choice == @configs+1 ) {
				print "What domain names do you want to search for partially\n" .
					"specified names?\n";
				print "Enter all of them on one line, seperated by spaces.\n";
				$search = QueryUser "Domain Names", undef;
				print "Enter the IP addresses of your nameservers\n";
				print "Enter a blank IP address to stop.\n";
				while(1) {
					my $address = QueryUser "Nameserver IP Address", undef;
					last unless defined $address;
					last if $address eq "";
					push @addresses, $address;
				}
			} else {
				$search = $dns_servers{$configs[$choice-1]}->{"search_list"};
				@addresses = @{$dns_servers{$configs[$choice-1]}->{"ip_list"}};
			}

			open(PPTP, ">$resolv_pptp") 
			or die "couldn't open $resolv_pptp for writing: $!";
			print PPTP "search $search\n";

			foreach my $a (@addresses) {
				print PPTP "nameserver $a\n";
			}
			close(PPTP) or die "couldn't close $resolv_pptp: $!";
		}
		if( -f $resolv_real) {
			my $diff = `diff $resolv $resolv_real`;
			chomp $diff;
			if($diff ne "") {
				print "** $resolv_real exists.\n";
				print "** copying it to $resolv_real.orig\n";
				unlink "$resolv_real.orig";
				rename $resolv_real, "$resolv_real.orig";
			}
		}
		BreakSymlink $resolv;
		print "Copying $resolv to $resolv_real...\n";
		`cp -f $resolv $resolv_real`;
		print "Creating link from $resolv_real to $resolv\n";
		`ln -sf $resolv_real $resolv`;
	} else { #they choose not to twiddle /etc/resolv.conf
		BreakSymlink $resolv;
		if( -f $resolv_pptp) {
			print "$resolv_pptp exists\n";
			if(yesno "Do you want to delete /etc/resolv.conf.pptp?") {
				unlink $resolv_pptp;
				print "$resolv_pptp deleted.\n";
			} else {
				print "** You have chosen not to delete $resolv_pptp\n" .
					"** This existing $resolv_pptp may still be used\n" .
					"** when tunnel connections are established.  If you\n" .
					"** really don't want it to be used, you should\n" .
					"** rename or remove it.\n";
			}
		}
		if( -f $resolv_real) {
			my $diff = `diff $resolv $resolv.real`;
			chomp $diff;
			if($diff eq "") {
				print "$resolv is identical to $resolv_real\n";
				if(yesno "Do you want to delete $resolv_real?") {
					unlink $resolv_real;
					print "$resolv_real deleted\n";
				}
			} else {
				print "** $resolv and $resolv_real both exist\n" .
					"** but are not the same.  You should decide which\n" .
					"** one is correct and make sure that file is named\n" .
					"** $resolv\n";
			}
		}
	}
}

#getCHAP
#
# This returns all the CHAP secrets with ***ed out the paswords
sub getCHAP() {
	if(-f $chap_secrets) {
		my @list= `cat $chap_secrets`;
		foreach my $secret (@list) {
			$secret =~ s/(.*\s)\S+\s*$/$1*****\n/
			unless $secret =~ /^\s*#/;
		}
		return @list;
	} else {
		return undef;
	}
}

#setup
#
# This is the part that does the old pptp-setup work.

#first the site-specific config files
sub setup() {
	my ($name, $search_list, $ip_list, $ip, @configs);
	foreach my $f (`ls $pptpdir`) {
		if($f !~ /^($safe_re)$/o) {
			print "Name your files something reasonable: \"$f\" doesn't qualify\n";
			next;
		}
		$f = $1;
		open(CONFIG, "<$pptpdir/$f") or next; #silently fail here
		@configs = <CONFIG>;
		close CONFIG;
		chomp $f;
			for(my $i=0; $i<=$#configs; $i++) {
				$configs[$i] =~ s/\#.*/ /o;
				if($configs[$i] =~ /\S/) {
					chomp $configs[$i];
					if($configs[$i] eq "nameservers") {
						until(++$i == @configs) {
							($name,$search_list,$ip_list) = split ':', $configs[$i];
							$name = $f ."-". $name;
							$dns_servers{$name}->{"search_list"}=$search_list;
							$dns_servers{$name}->{"ip_list"}=[split ' ', $ip_list];
						}
					} else {
						($name,$ip) = split ' ', $configs[$i];
						$name = $f ."-". $name;
						$pptp_servers{$name}->{"ip"}=$ip;
						$pptp_servers{$name}->{"routes"}=[];
						until($configs[++$i] eq "\n") {
							chomp $configs[$i];
							if($configs[$i] =~ /$unsafe_re/o ) {
								print "WARNING: the line:\n",
								"$configs[$i]\n",
								"contains unsafe characters!\n";
								next;
							}
							$pptp_servers{$name}->{"routes"}=[@{$pptp_servers{$name}->{"routes"}},$configs[$i]];
						}
					}
				}
			}
	}
#ok.  now all the info from the config files is in %pptp_servers and %dns_servers.  now let's do something with it.

	while(1) {
		my $task = bselect "?", "List CHAP secrets", "Add a New CHAP secret",
		"Delete a CHAP secret", "List PPTP Tunnels", "Add a NEW PPTP Tunnel",
		"Delete a PPTP Tunnel", "Configure resolv.conf", "Select a default tunnel", "Quit";

		if($task eq "1") {
			print "Current CHAP secrets:\n";
			my @list = getCHAP;
			if( @list ) {
				print @list;
			} else {
				print "	None.\n";
			}
		} elsif($task eq "2") {
			AddCHAP;
		} elsif($task eq "3") {
			my @list = getCHAP;
			if( @list) {
				print "Select one of the pair of lines that you want removed.\n";
				print "Both matching lines will be deleted.\n";
				my $choice = bselect "Remove which CHAP secret?", @list, "None";
				$choice--;
				if($choice == @list) {
					print "Aborted Deleting a CHAP secret\n";
					next;
				} else {
					`stty -echo`;
					my $passwd = QueryUser "Enter the password for this CHAP secret", undef;
					`stty echo`;
					my @chaps = `cat $chap_secrets`;
					open(CHAP, ">$chap_secrets") or die "Couldn't open $chap_secrets for writing: $!";
					my ($local, $remote, undef) = split(/\s/, $list[$choice]);
					my $count = 0;
					foreach my $c (@chaps) {
						my ($c_local, $c_remote, $c_secret, undef) = split(/\s/, $c);
						if($c_secret eq $passwd && (
							($c_local eq $local && $c_remote eq $remote) ||
							($c_local eq $remote && $c_remote eq $local)
						)) {
							$count++;
							next;
						} else {
							print CHAP $c;
						}
					}
					close(CHAP) or die "Couldn't close $chap_secrets after writing: $!";
					print "\nDeleted $count entries.";
					print " Perhaps you mistyped the password?" if $count == 0;
					print "\n";
				}
			}
		} elsif($task eq "4") {
			my @tunnels = ConfiguredTunnels;
			print "Current Tunnels:\n";
			if(scalar(@tunnels) != 0) {
				print join "\n", @tunnels;
				print "\n";
			} else {
				print "	None.\n";
			}
		} elsif($task eq "5") {
			AddPPTP;
		} elsif($task eq "6") {
			my $tunnel = SelectTunnel "Delete which tunnel?";
			DelTunnel $tunnel if $tunnel ne "";
		} elsif($task eq "7") {
			ConfigureResolv;
		} elsif($task eq "8") {
			my @tunnels = ConfiguredTunnels;
			if( -l "$tunnel_dir/__default" ) {
				print "The current default is ".readlink("$tunnel_dir/__default")."\n";
			}
			if( -f _ ) {
				die "$tunnel_dir/__default is a regular file not a symlink!\n";
			}
			my $choice = bselect "Which tunnel do you want to be the default?", @tunnels, "cancel";
			next if $choice == @tunnels+1;
			unlink "$tunnel_dir/__default";
			my $scratch = $tunnel_dir."/".$tunnels[$choice-1];
			$scratch = $1 if $scratch =~ /^($safe_re)$/o;
			symlink $scratch, "$tunnel_dir/__default" or die "couldn't create __defualt symlink: $!";
		} elsif($task eq "9" || $task eq "q") {
			exit 0;
		}
	}
}

#start
#
# This does the old pptp-start work
sub start() {
	my ($tunnel, $f, @filter, @ifs, $if, @foo);
	my @tunnels = ConfiguredTunnels;
	die "no configured tunnels!\n" if @tunnels == 0;

	if(defined $ARGV[1]) {
		$tunnel = $ARGV[1];
	} elsif(-l "$tunnel_dir/__default" && defined $ARGV[0]) {
		my $default = readlink "$tunnel_dir/__default";
		$tunnel = (split '/', $default)[-1];
	} elsif(-t STDIN && -t STDOUT) {
		$tunnel = SelectTunnel "Start a tunnel to which server?";
	} else {
		usage;
	}

	die "Nasty characters in $tunnel\n" if $tunnel !~ /^($safe_re)$/o;
	$tunnel = $1;
	my $config = "$tunnel_dir/$tunnel";
	die "Tunnel configuration for $tunnel not found\n" unless -f $config;

	open(CONFIG, "<$config") or die "couldn't open $config: $!";
	my @conf = <CONFIG>;
	close CONFIG;
	my ($ip,undef) = grep {/Server IP/} @conf;
	my $server = undef;
	$server = $1 if $ip =~ /.*IP: ([-a-zA-Z0-9\.]+).*/;
	die "Server Address for $tunnel not found.\n" 
	    unless defined $server;

	#build a regexp of the currently existing interfaces
	my @ifconfig = `/sbin/ifconfig`;
	foreach $f (@ifconfig) {
		next unless $f =~ /^[a-z]/;
		@foo=split ' ', $f;
		push @filter, $foo[0];
	}
	my $if_re = join '|', @filter;

	#bring up the tunnel
	my $child = fork;
	if ($child == 0) {
		exec "/usr/sbin/pptp $server call $tunnel";
		die "exec of pptp failed.";
	}

	my $timeout=60;
	while(1) {
		die "ERROR!  Connection timed out.\n" if $timeout==0;
		$timeout--;
		@ifs = ();
		sleep 1;
		@ifconfig=`/sbin/ifconfig`;
		foreach $f (@ifconfig) {
			next unless $f =~ /^[a-z]/;
			@foo=split ' ', $f;
			push @ifs, $foo[0];
		}
		($if, undef) = grep {!/$if_re/} @ifs;
		last if defined $if;
	}
	die "something screwy in your interface names: $if\n" if $if !~ /^($safe_re)$/o;
	$if = $1;
	(grep {/inet/} `/sbin/ifconfig $if`)[0] =~ /:(\d+\.\d+\.\d+\.\d+)/;
	$ip = $1;

	my (undef, $gw, undef) = split ' ', (`/sbin/route -n`)[-1];


	my @routes = grep {/Route/} @conf;
	open(LOCK, ">>$subsys_dir/pptp") or die "couldn't open lock file: $!";
	foreach my $r (@routes) {
		chomp $r;
		$r =~ s/.*?Route: //;
		if ($r !~ /^($safe_re)$/o) {
			print "WARNING: $r countains unsafe characters. Ignoring it.\n";
			next;
		}
		$r = $1;
		$r =~ s/TUNNEL_DEV/$if/og;
		$r =~ s/DEF_GW/$gw/og;
		die "route failed on $r" if system("/sbin/route $r");
		#store the routes added in the lock file so they can be ripped down during stop.
		print "Route: $r added\n";
		print LOCK "$r\n";
	}
	close LOCK or die "couldn't close lock file: $!";
	print "All routes added.\n";
	print "Tunnel $tunnel is active on $if.  IP Address: $ip\n";
	Rotate $resolv, $resolv_pptp, $resolv_real;
	exit 0;
}

#stop
#
# this does the old pptp-stop work
sub stop() {
	Rotate $resolv, $resolv_real, $resolv_pptp;
	print "Sending HUP signal to PPTP processes...\n";
	`killall -HUP pptp`;
	open(LOCK, "<$subsys_dir/pptp") or goto "skip";
	while(my $r = <LOCK>) {
		chomp $r;
		if ($r !~ /^($safe_re)$/o) {
			print "someone is messing with the lock files in a bad way\n";
			print "ignoring all remaining route commands.\n";
			last;
		}
		$r = $1;
		$r =~ s/add/del/o;
		system("/sbin/route $r >/dev/null 2>&1"); #many of these will fail... that's fine.
	}
	close LOCK;
skip:
	unlink "$subsys_dir/pptp";
	sleep 2;
	exit 0;
}

if(defined $ARGV[0]) {
	if($ARGV[0] eq "setup") {
		setup;
	} elsif($ARGV[0] eq "start") {
		start;
	} elsif($ARGV[0] eq "stop") {
		stop;
	} elsif($ARGV[0] eq "status") {
		if( -f "$subsys_dir/pptp") {
			print "There is probably a pptp tunnel up\n";
			exit 0;
		} else {
			print "There is probably not a pptp tunnel up\n";
			exit 3;
		}
	} elsif($ARGV[0] eq "restart" || $ARGV[0] eq "force-reload" || $ARGV[0] eq "reload") {
		print STDERR "$ARGV[0] is not implimented yet\n";
		exit 3;
	}
}
if(! -t STDIN || ! -t STDOUT) {
	usage;
}
my $mode = bselect "What task would you like to do?", "start", "stop", "setup", "quit";
if($mode eq "1") {
	start;
} elsif($mode eq "2") {
	stop;
} elsif($mode eq "3") {
	setup;
} elsif($mode eq "4" or $mode eq "q") {
	exit 0;
}
