- bsc#1194714: Remove pptp-command (the former SysV init scirpt).
It has been broken for a long time (seeking deprecated ifconfig in the wrong location) without any complaints, so it seems safe to assume it is not being used anymore. OBS-URL: https://build.opensuse.org/package/show/network/pptp?expand=0&rev=15
This commit is contained in:
parent
fd58a32fb7
commit
e7ecf7c82c
871
pptp-command
871
pptp-command
@ -1,871 +0,0 @@
|
||||
#!/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 PPPD processes...\n";
|
||||
# (sb) kill pppd instead of pptp - cleaner interaction with "service"
|
||||
`killall -HUP pppd`;
|
||||
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;
|
||||
}
|
@ -1,3 +1,11 @@
|
||||
-------------------------------------------------------------------
|
||||
Fri Feb 4 05:20:42 UTC 2022 - Reinhard Max <max@suse.com>
|
||||
|
||||
- bsc#1194714: Remove pptp-command (the former SysV init scirpt).
|
||||
It has been broken for a long time (seeking deprecated ifconfig
|
||||
in the wrong location) without any complaints, so it seems safe
|
||||
to assume it is not being used anymore.
|
||||
|
||||
-------------------------------------------------------------------
|
||||
Thu Oct 28 20:08:59 UTC 2021 - Reinhard Max <max@suse.com>
|
||||
|
||||
|
@ -1,7 +1,7 @@
|
||||
#
|
||||
# spec file for package pptp
|
||||
#
|
||||
# Copyright (c) 2021 SUSE LLC
|
||||
# Copyright (c) 2022 SUSE LLC
|
||||
#
|
||||
# All modifications and additions to the file contributed by third parties
|
||||
# remain the property of their copyright owners, unless otherwise agreed
|
||||
@ -24,7 +24,6 @@ License: GPL-2.0-or-later
|
||||
Group: Productivity/Networking/Security
|
||||
URL: http://pptpclient.sourceforge.net/
|
||||
Source: http://downloads.sourceforge.net/project/pptpclient/pptp/pptp-%{version}/%{name}-%{version}.tar.gz
|
||||
Source1: pptp-command
|
||||
Source2: options.pptp
|
||||
Source3: pptp_fe.pl
|
||||
Source4: xpptp_fe.pl
|
||||
@ -50,7 +49,6 @@ make install DESTDIR=%{buildroot}
|
||||
mkdir -p %{buildroot}%{_sysconfdir}/ppp
|
||||
mkdir -p %{buildroot}%{_sysconfdir}/pptp.d
|
||||
|
||||
cp %{SOURCE1} %{buildroot}%{_sbindir}/pptp-command
|
||||
cp %{SOURCE2} %{buildroot}%{_sysconfdir}/ppp
|
||||
|
||||
find Documentation -name CVS | xargs rm -rf
|
||||
@ -64,7 +62,6 @@ find Reference -name CVS | xargs rm -rf
|
||||
%attr(0755,root,root) %{_sbindir}/pptpsetup
|
||||
%attr(0444,root,root) %{_mandir}/man8/pptp.8.gz
|
||||
%attr(0444,root,root) %{_mandir}/man8/pptpsetup.8.gz
|
||||
%attr(0755,root,root) %{_sbindir}/pptp-command
|
||||
%attr(750, root, root) %dir %{_sysconfdir}/ppp
|
||||
%config %attr(0600,root,root) %{_sysconfdir}/ppp/options.pptp
|
||||
%attr(0755,root,root) %{_sysconfdir}/pptp.d
|
||||
|
Loading…
Reference in New Issue
Block a user