openSUSE Build Service

Overview Repositories Revisions Requests Users Attributes Meta

File pptp-command of Package pptp (Revision 7397e6b4365615da5cee92ed2ee3a38c)

Currently displaying revision 7397e6b4365615da5cee92ed2ee3a38c , Show latest

#!/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.12 2001/12/20 13:09:02 jwiedemeier 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";
my $pap_secrets = "$pppdir/pap-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};
delete $ENV{ENV};

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;
	}
	# force $name to be untainted
	# ($name is clean because it passed the -f test above, 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;
}

#AddCHAPorPAP - interactive
#
# Prompts for parameters and adds a CHAP or PAP secret
#
sub AddCHAPorPAP {
	my $secret_type = $_[0];

print
	"Add a NEW $secret_type secret.

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

Local Name:

This is the 'local' identifier for $secret_type 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 $secret_type authentication.
In most cases, this can be left as the default. It must be
set if you have multiple $secret_type 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 $secret_type 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`;

my $secrets_file = "";
	
	if( $secret_type eq "CHAP")	{
		$secrets_file = $chap_secrets;
	} elsif( $secret_type eq "PAP")	{
		$secrets_file = $pap_secrets;
	} else { 
		die ( "wrong sercet type!");
	}

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

#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) {
		while (1) {
			$name = QueryUser "Tunnel Name", undef;
			# per man perlsec, check for special characters
			if ($name =~ /^([-\@\w.]+)$/) {
				$name = $1;
				last;
			}
			print "Name contains special characters.\n";
			print "Please use only alphanumerics, '-', '_', '.', and '\@'.\n";
		}
		$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 or PAP 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";
			}
		}
	}
}

#getCHAPorPAP
#
# This returns all the CHAP or PAP secrets with ***ed out the paswords
sub getCHAPorPAP {
	my $secret_type = $_[0];
	
	my $secrets_file = "";
	
	if( $secret_type eq "CHAP")	{
		$secrets_file = $chap_secrets;
	} elsif( $secret_type eq "PAP")	{
		$secrets_file = $pap_secrets;
	} else { 
		die ( "wrong sercet type!");
	}

if(-f $secrets_file) {
		my @list= `cat $secrets_file`;
		foreach my $secret (@list) {
			$secret =~ s/(.*\s)\S+\s*$/$1*****\n/
			unless $secret =~ /^\s*#/;
		}
		return @list;
	} else {
		return undef;
	}
}

#ManageSecrets
#
# This manages secret files
sub ManageSecrets {
	my $secret_type=$_[0];
	
	while(1) {
		my $manage_task = bselect "?", "List $secret_type secrets", 
		                               "Add a New $secret_type secret", 
									   "Delete a $secret_type secret",
									   "Quit";
								   
		if( $manage_task eq "1") {
			print "Current $secret_type secrets:\n";
			my @list = getCHAPorPAP( $secret_type);

if( @list ) {
				print @list;
			} else {
				print "	None.\n";
			}		
		} elsif( $manage_task eq "2") {
			AddCHAPorPAP( $secret_type);
		} elsif( $manage_task eq "3") {
			my @list; 
			my $secrets_file;
			if( $secret_type eq "CHAP") {
				$secrets_file = $chap_secrets;
			} elsif( $secret_type eq "PAP") {
				$secrets_file = $pap_secrets;
			} else {
				die "wrong secret_type!";
			}
			
			@list = getCHAPorPAP( $secret_type);
			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 $secret_type secret?", @list, "None";
				$choice--;
				if($choice == @list) {
					print "Aborted Deleting a $secret_type secret\n";
					next;
				} else {
					`stty -echo`;
					my $passwd = QueryUser "Enter the password for this $secret_type secret", undef;
					`stty echo`;
					my @secrets = `cat $secrets_file`;
					open(SECRETS_FILE, ">$secrets_file") or die "Couldn't open $secrets_file for writing: $!";
					my ($local, $remote, undef) = split(/\s/, $list[$choice]);
					my $count = 0;
					foreach my $c (@secrets) {
						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 SECRETS_FILE $c;
						}
					}
  					close(SECRETS_FILE) or die "Couldn't close $secrets_file after writing: $!";
					print "\nDeleted $count entries.";
					print " Perhaps you mistyped the password?" if $count == 0;
					print "\n";
				}	
			}
		} elsif( $manage_task eq "4" || $manage_task eq "q") {
			last;
		} else {
			next;
		}
	}
}

#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 "?", "Manage CHAP secrets", 
		                        "Manage PAP secrets", 
		                        "List PPTP Tunnels", 
								"Add a NEW PPTP Tunnel",
                        		"Delete a PPTP Tunnel", 
								"Configure resolv.conf", 
								"Select a default tunnel", 
								"Quit";

if($task eq "1") {
			ManageSecrets( "CHAP");
		} elsif($task eq "2") {
			ManageSecrets( "PAP");
		} elsif($task eq "3") {
			my @tunnels = ConfiguredTunnels;
			print "Current Tunnels:\n";
			if(scalar(@tunnels) != 0) {
				print join "\n", @tunnels;
				print "\n";
			} else {
				print "	None.\n";
			}
		} elsif($task eq "4") {
			AddPPTP;
		} elsif($task eq "5") {
			my $tunnel = SelectTunnel "Delete which tunnel?";
			DelTunnel $tunnel if $tunnel ne "";
		} elsif($task eq "6") {
			ConfigureResolv;
		} elsif($task eq "7") {
			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 "8" || $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;
		# script runs in tainted mode, so $r has to be detaineted/laundered
		# (funny thing is, it should be clean already ...)
		# $r should be safe (see above: $safe_re)
		$r =~ m/(.*)/;
		$r = $1;
		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;
}

Places

File pptp-command of Package pptp (Revision 7397e6b4365615da5cee92ed2ee3a38c)

Places