This commit is contained in:
OBS User unknown
Git OBS Bridge
commit
dab1debd25
23
.gitattributes
vendored
Normal file
23
.gitattributes
vendored
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
## Default LFS
|
||||||
|
*.7z filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.bsp filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.bz2 filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.gem filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.gz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.jar filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.lz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.lzma filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.obscpio filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.oxt filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.pdf filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.png filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.rpm filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.tbz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.tbz2 filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.tgz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.ttf filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.txz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.whl filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.xz filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.zip filter=lfs diff=lfs merge=lfs -text
|
||||||
|
*.zst filter=lfs diff=lfs merge=lfs -text
|
||||||
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
.osc
|
||||||
32
options.pptp
Normal file
32
options.pptp
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
#
|
||||||
|
# Lock the port
|
||||||
|
#
|
||||||
|
lock
|
||||||
|
|
||||||
|
#
|
||||||
|
# We don't need the tunnel server to authenticate itself
|
||||||
|
#
|
||||||
|
noauth
|
||||||
|
|
||||||
|
#
|
||||||
|
# Turn off transmission protocols we know won't be used
|
||||||
|
#
|
||||||
|
nobsdcomp
|
||||||
|
nodeflate
|
||||||
|
|
||||||
|
#
|
||||||
|
# We want MPPE
|
||||||
|
#
|
||||||
|
require-mppe
|
||||||
|
|
||||||
|
#
|
||||||
|
# We want a sane mtu/mru
|
||||||
|
#
|
||||||
|
mtu 1000
|
||||||
|
mru 1000
|
||||||
|
|
||||||
|
#
|
||||||
|
# Time this thing out of it goes poof
|
||||||
|
#
|
||||||
|
lcp-echo-failure 10
|
||||||
|
lcp-echo-interval 10
|
||||||
3
pptp-1.7.1.tar.bz2
Normal file
3
pptp-1.7.1.tar.bz2
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
version https://git-lfs.github.com/spec/v1
|
||||||
|
oid sha256:fdd1dcaa8ae9eea18c380306254aa671e97db9b8cd348fb18a5ad867fb5497fe
|
||||||
|
size 180858
|
||||||
870
pptp-command
Normal file
870
pptp-command
Normal file
@ -0,0 +1,870 @@
|
|||||||
|
#!/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;
|
||||||
|
}
|
||||||
11
pptp-makefile.patch
Normal file
11
pptp-makefile.patch
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
--- Makefile
|
||||||
|
+++ Makefile
|
||||||
|
@@ -54,7 +54,7 @@
|
||||||
|
|
||||||
|
install:
|
||||||
|
mkdir -p $(BINDIR)
|
||||||
|
- install -o root -m 555 pptp $(BINDIR)
|
||||||
|
+ install -m 555 pptp $(BINDIR)
|
||||||
|
mkdir -p $(MANDIR)
|
||||||
|
install -m 644 pptp.8 $(MANDIR)
|
||||||
|
|
||||||
100
pptp.changes
Normal file
100
pptp.changes
Normal file
@ -0,0 +1,100 @@
|
|||||||
|
-------------------------------------------------------------------
|
||||||
|
Thu Nov 2 15:09:53 CET 2006 - hvogel@suse.de
|
||||||
|
|
||||||
|
- launder route variable in pptp-command (taint mode) [#214627]
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon Oct 23 19:43:24 CEST 2006 - hvogel@suse.de
|
||||||
|
|
||||||
|
- update to version 1.7.1
|
||||||
|
* use prctl(2) to set process name
|
||||||
|
* remove superfluous sigset variable and calls
|
||||||
|
* default to not require MPPE
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Wed Jan 25 21:40:36 CET 2006 - mls@suse.de
|
||||||
|
|
||||||
|
- converted neededforbuild to BuildRequires
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon Aug 01 09:40:58 CEST 2005 - arvin@suse.de
|
||||||
|
|
||||||
|
- updated to version 1.7.0
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Tue Mar 15 11:31:12 CET 2005 - arvin@suse.de
|
||||||
|
|
||||||
|
- updated to version 1.6.0:
|
||||||
|
- several bug-fixes
|
||||||
|
- add --idle-wait option
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon Aug 9 14:20:33 CEST 2004 - meissner@suse.de
|
||||||
|
|
||||||
|
- Upgraded to 1.5.0:
|
||||||
|
- fix statistics when buffering disabled [Wilson]
|
||||||
|
- do not inherit the GRE socket [Cameron]
|
||||||
|
- fix a case of non-shutdown of call manager [Klazes]
|
||||||
|
- add --nobuffer option to eliminate all buffering of packets [Wilson]
|
||||||
|
- fix corruption of command line as shown by ps [Howarth]
|
||||||
|
- fix CPU loop after pppd killed [Cameron]
|
||||||
|
- fix compile for ARM architecture [Hopf]
|
||||||
|
- add documentation for command-line options [Wilson]
|
||||||
|
- do not hang when a connection is refused [McCurdy]
|
||||||
|
- better describe a cause of EMSGSIZE [Cameron]
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Tue Jun 22 11:41:38 CEST 2004 - arvin@suse.de
|
||||||
|
|
||||||
|
- use new options in options.pptp
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon Mar 1 16:42:46 CET 2004 - hmacht@suse.de
|
||||||
|
|
||||||
|
- building as nonroot-user
|
||||||
|
- added patch pptp-makefile.patch because of wrong permissions
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Thu Feb 12 14:10:52 CET 2004 - meissner@suse.de
|
||||||
|
|
||||||
|
- Upgraded to 1.4.0:
|
||||||
|
- support options before hostname [Wilson]
|
||||||
|
- defer OCRQ until after SCCRP [Cameron]
|
||||||
|
- include uninstall target [Pieter]
|
||||||
|
- only issue a warning if sync mode is different to pppd [Klazes]
|
||||||
|
- reformat and tidy code [Klazes]
|
||||||
|
- reduce transmitted ack-only packets from 40% to 0.8% [Klazes]
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Wed Jun 11 13:20:29 CEST 2003 - meissner@suse.de
|
||||||
|
|
||||||
|
- Upgraded to 1.3.1 bugfix release.
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Wed Jun 11 12:53:53 CEST 2003 - meissner@suse.de
|
||||||
|
|
||||||
|
- Upgraded to 1.3.0.
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon May 19 15:47:48 CEST 2003 - meissner@suse.de
|
||||||
|
|
||||||
|
- remove CVS files from install.
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Tue Feb 18 10:32:42 CET 2003 - meissner@suse.de
|
||||||
|
|
||||||
|
- Upgrade to upstream 1.2.0:
|
||||||
|
- fix response to dropped packets.
|
||||||
|
- fix man page, address must be before options.
|
||||||
|
- close stderr to prevent holding open ssh sessions.
|
||||||
|
- minor hint added in case of EIO on read() of pty.
|
||||||
|
- support synchronous HDLC ppp encoding. Synchronous mode results in an
|
||||||
|
important improvement of the CPU efficiency.
|
||||||
|
- handle out-of-order packets arriving on the GRE socket by buffering.
|
||||||
|
- bind GRE socket early to prevent ICMP Unreachable response by client.
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
Mon Nov 11 13:10:18 CET 2002 - meissner@suse.de
|
||||||
|
|
||||||
|
- initial packaging.
|
||||||
|
|
||||||
137
pptp.spec
Normal file
137
pptp.spec
Normal file
@ -0,0 +1,137 @@
|
|||||||
|
#
|
||||||
|
# spec file for package pptp (Version 1.7.1)
|
||||||
|
#
|
||||||
|
# Copyright (c) 2006 SUSE LINUX Products GmbH, Nuernberg, Germany.
|
||||||
|
# This file and all modifications and additions to the pristine
|
||||||
|
# package are under the same license as the package itself.
|
||||||
|
#
|
||||||
|
# Please submit bugfixes or comments via http://bugs.opensuse.org/
|
||||||
|
#
|
||||||
|
|
||||||
|
# norootforbuild
|
||||||
|
|
||||||
|
Name: pptp
|
||||||
|
URL: http://pptpclient.sourceforge.net/
|
||||||
|
Summary: Point-to-Point Tunneling Protocol (PPTP) Client
|
||||||
|
Version: 1.7.1
|
||||||
|
Release: 4
|
||||||
|
Source: %{name}-%{version}.tar.bz2
|
||||||
|
Source1: pptp-command
|
||||||
|
Source2: options.pptp
|
||||||
|
Source3: pptp_fe.pl
|
||||||
|
Source4: xpptp_fe.pl
|
||||||
|
Patch1: pptp-makefile.patch
|
||||||
|
License: GNU General Public License (GPL) - all versions
|
||||||
|
Group: Productivity/Networking/Security
|
||||||
|
BuildRoot: %{_tmppath}/%{name}-%{version}-build
|
||||||
|
|
||||||
|
%description
|
||||||
|
A client for the proprietary Microsoft Point-to-Point Tunneling
|
||||||
|
Protocol, PPTP. It allows connections to a PPTP based VPN as used by
|
||||||
|
employers and some cable and ADSL service providers. It requires MPPE
|
||||||
|
support in the kernel. Use the ppp-mppe package.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Authors:
|
||||||
|
--------
|
||||||
|
C. Scott Ananian <cananian@alumni.princeton.edu>
|
||||||
|
|
||||||
|
Christoph Lameter <christoph@lameter.com>
|
||||||
|
Gordon Chaffee <chaffee@HOME.COM>
|
||||||
|
mulix <mulix@actcom.co.il>
|
||||||
|
James Cameron <james.cameron@compaq.com>
|
||||||
|
Rein Klazes <rklazes@xs4all.nl>
|
||||||
|
Thomas Quinot <thomas@cuivre.fr.eu.org>
|
||||||
|
Rhialto <rhialto@azenomei.knuffel.net>
|
||||||
|
Scott Venier <scott@scooter.cx>
|
||||||
|
Jeff Wiedemeier <Jeff.Wiedemeier@compaq.com>
|
||||||
|
Yura Zotov <yz@altlinux.ru>
|
||||||
|
|
||||||
|
%prep
|
||||||
|
%setup -q -n %{name}-%{version}
|
||||||
|
%patch1
|
||||||
|
|
||||||
|
%build
|
||||||
|
make CFLAGS="$RPM_OPT_FLAGS"
|
||||||
|
|
||||||
|
%install
|
||||||
|
make install DESTDIR=$RPM_BUILD_ROOT
|
||||||
|
mkdir -p $RPM_BUILD_ROOT/etc/ppp
|
||||||
|
mkdir -p $RPM_BUILD_ROOT/etc/pptp.d
|
||||||
|
cp %{SOURCE1} $RPM_BUILD_ROOT/usr/sbin/pptp-command
|
||||||
|
cp %{SOURCE2} $RPM_BUILD_ROOT/etc/ppp
|
||||||
|
find Documentation -name CVS | xargs rm -rf
|
||||||
|
find Reference -name CVS | xargs rm -rf
|
||||||
|
|
||||||
|
%clean
|
||||||
|
rm -rf $RPM_BUILD_ROOT
|
||||||
|
|
||||||
|
%files
|
||||||
|
%defattr(0644,root,root,0755)
|
||||||
|
%doc AUTHORS COPYING INSTALL NEWS README TODO USING Documentation Reference
|
||||||
|
%attr(0755,root,root) /usr/sbin/pptp
|
||||||
|
%attr(0444,root,root) %{_mandir}/man8/pptp.8.gz
|
||||||
|
%attr(0755,root,root) /usr/sbin/pptp-command
|
||||||
|
%config %attr(0600,root,root) /etc/ppp/options.pptp
|
||||||
|
%attr(0755,root,root) /etc/pptp.d
|
||||||
|
|
||||||
|
%changelog -n pptp
|
||||||
|
* Thu Nov 02 2006 - hvogel@suse.de
|
||||||
|
- launder route variable in pptp-command (taint mode) [#214627]
|
||||||
|
* Mon Oct 23 2006 - hvogel@suse.de
|
||||||
|
- update to version 1.7.1
|
||||||
|
* use prctl(2) to set process name
|
||||||
|
* remove superfluous sigset variable and calls
|
||||||
|
* default to not require MPPE
|
||||||
|
* Wed Jan 25 2006 - mls@suse.de
|
||||||
|
- converted neededforbuild to BuildRequires
|
||||||
|
* Mon Aug 01 2005 - arvin@suse.de
|
||||||
|
- updated to version 1.7.0
|
||||||
|
* Tue Mar 15 2005 - arvin@suse.de
|
||||||
|
- updated to version 1.6.0:
|
||||||
|
- several bug-fixes
|
||||||
|
- add --idle-wait option
|
||||||
|
* Mon Aug 09 2004 - meissner@suse.de
|
||||||
|
- Upgraded to 1.5.0:
|
||||||
|
- fix statistics when buffering disabled [Wilson]
|
||||||
|
- do not inherit the GRE socket [Cameron]
|
||||||
|
- fix a case of non-shutdown of call manager [Klazes]
|
||||||
|
- add --nobuffer option to eliminate all buffering of packets [Wilson]
|
||||||
|
- fix corruption of command line as shown by ps [Howarth]
|
||||||
|
- fix CPU loop after pppd killed [Cameron]
|
||||||
|
- fix compile for ARM architecture [Hopf]
|
||||||
|
- add documentation for command-line options [Wilson]
|
||||||
|
- do not hang when a connection is refused [McCurdy]
|
||||||
|
- better describe a cause of EMSGSIZE [Cameron]
|
||||||
|
* Tue Jun 22 2004 - arvin@suse.de
|
||||||
|
- use new options in options.pptp
|
||||||
|
* Mon Mar 01 2004 - hmacht@suse.de
|
||||||
|
- building as nonroot-user
|
||||||
|
- added patch pptp-makefile.patch because of wrong permissions
|
||||||
|
* Thu Feb 12 2004 - meissner@suse.de
|
||||||
|
- Upgraded to 1.4.0:
|
||||||
|
- support options before hostname [Wilson]
|
||||||
|
- defer OCRQ until after SCCRP [Cameron]
|
||||||
|
- include uninstall target [Pieter]
|
||||||
|
- only issue a warning if sync mode is different to pppd [Klazes]
|
||||||
|
- reformat and tidy code [Klazes]
|
||||||
|
- reduce transmitted ack-only packets from 40%% to 0.8%% [Klazes]
|
||||||
|
* Wed Jun 11 2003 - meissner@suse.de
|
||||||
|
- Upgraded to 1.3.1 bugfix release.
|
||||||
|
* Wed Jun 11 2003 - meissner@suse.de
|
||||||
|
- Upgraded to 1.3.0.
|
||||||
|
* Mon May 19 2003 - meissner@suse.de
|
||||||
|
- remove CVS files from install.
|
||||||
|
* Tue Feb 18 2003 - meissner@suse.de
|
||||||
|
- Upgrade to upstream 1.2.0:
|
||||||
|
- fix response to dropped packets.
|
||||||
|
- fix man page, address must be before options.
|
||||||
|
- close stderr to prevent holding open ssh sessions.
|
||||||
|
- minor hint added in case of EIO on read() of pty.
|
||||||
|
- support synchronous HDLC ppp encoding. Synchronous mode results in an
|
||||||
|
important improvement of the CPU efficiency.
|
||||||
|
- handle out-of-order packets arriving on the GRE socket by buffering.
|
||||||
|
- bind GRE socket early to prevent ICMP Unreachable response by client.
|
||||||
|
* Mon Nov 11 2002 - meissner@suse.de
|
||||||
|
- initial packaging.
|
||||||
370
pptp_fe.pl
Normal file
370
pptp_fe.pl
Normal file
@ -0,0 +1,370 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
#
|
||||||
|
# $Id: pptp_fe.pl,v 1.1 2001/11/29 05:19:10 quozl Exp $
|
||||||
|
#
|
||||||
|
# pptp_fe.pl, privileged portion of xpptp_fe.pl
|
||||||
|
# Copyright (C) 2001 Smoot Carl-Mitchell (smoot@tic.com)
|
||||||
|
#
|
||||||
|
# This program is free software; you can redistribute it and/or modify
|
||||||
|
# it under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 2 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# This program is distributed in the hope that it will be useful,
|
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with this program; if not, write to the Free Software
|
||||||
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
#
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use Getopt::Std;
|
||||||
|
use Time::localtime;
|
||||||
|
use IO::Handle;
|
||||||
|
|
||||||
|
my $Usage = "usage: pptp_fe [-c config_file] [-d] [-h] [-k] [-n network]
|
||||||
|
[-p] [-r routes] [-t timeout] [host]
|
||||||
|
where:
|
||||||
|
-c - configuration file (default is ~/.pptp_fe.conf)
|
||||||
|
-d - pppd debug flag
|
||||||
|
-h - this help message
|
||||||
|
-k - kill pppd daemon with route to network
|
||||||
|
-n - network number of remote private network in x.x.x.x/n notation
|
||||||
|
-r - routes to add to routing table separated by commas
|
||||||
|
-p - suppress prompting
|
||||||
|
-t - connection timeout retry interval in seconds (default 60 seconds)
|
||||||
|
host - remote PPTP server name
|
||||||
|
";
|
||||||
|
|
||||||
|
my %Opt;
|
||||||
|
getopts("c:dhkn:pr:t:", \%Opt);
|
||||||
|
|
||||||
|
my $Config_File = $Opt{'c'};
|
||||||
|
$Config_File = "$ENV{'HOME'}/.pptp_fe.conf" unless $Opt{'c'};
|
||||||
|
my $Config;
|
||||||
|
my $Debug = $Opt{'d'};
|
||||||
|
$Debug = 0 unless $Debug;
|
||||||
|
my $Debug_Flag = "debug" if $Debug;
|
||||||
|
my $Help = $Opt{'h'};
|
||||||
|
my $Kill = $Opt{'k'};
|
||||||
|
my $Net = $Opt{'n'};
|
||||||
|
my $No_Prompt = $Opt{'p'};
|
||||||
|
my $Route = $Opt{'r'};
|
||||||
|
my $Timeout = $Opt{'t'}; $Timeout = 60 unless $Timeout;
|
||||||
|
|
||||||
|
print($Usage), exit(1) if $Help;
|
||||||
|
|
||||||
|
my $Server = $ARGV[0];
|
||||||
|
|
||||||
|
my $State = "disconnected";
|
||||||
|
|
||||||
|
system("modprobe ppp-compress-18");
|
||||||
|
|
||||||
|
$Config = cmd_read_config_file($Config_File);
|
||||||
|
for my $cmd (@$Config) {
|
||||||
|
cmd_set($cmd, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
print "($State) > " unless $No_Prompt;
|
||||||
|
STDOUT->flush;
|
||||||
|
for (;;) {
|
||||||
|
my $rin = '';
|
||||||
|
my $rout = '';
|
||||||
|
vec($rin, fileno(STDIN), 1) = 1;
|
||||||
|
command() if select($rout=$rin, undef, undef, 5);
|
||||||
|
|
||||||
|
my $interface = "";
|
||||||
|
if ($State eq "connected" && ! ($interface = net_interface_up($Net))) {
|
||||||
|
print "\n";
|
||||||
|
print "interface $interface for $Net not up - restarting\n";
|
||||||
|
cmd_connect();
|
||||||
|
print "($State) > " unless $No_Prompt;;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub command {
|
||||||
|
|
||||||
|
my $input;
|
||||||
|
sysread(STDIN, $input, 1024);
|
||||||
|
|
||||||
|
for my $line1 (split("\n", $input)) {
|
||||||
|
my $line = $line1;
|
||||||
|
$line =~ s/\s*$//;
|
||||||
|
$line =~ s/^\s*//;
|
||||||
|
my ($command, $arguments) = split(" ", $line, 2);
|
||||||
|
|
||||||
|
if ($command eq "c") {
|
||||||
|
cmd_connect();
|
||||||
|
}
|
||||||
|
elsif ($command eq "d") {
|
||||||
|
cmd_disconnect();
|
||||||
|
}
|
||||||
|
elsif ($command eq "h") {
|
||||||
|
cmd_help();
|
||||||
|
}
|
||||||
|
elsif ($command eq "l") {
|
||||||
|
cmd_list();
|
||||||
|
}
|
||||||
|
elsif ($command eq "q") {
|
||||||
|
cmd_disconnect();
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
elsif ($command eq "r") {
|
||||||
|
$Config = cmd_read_config_file($arguments);
|
||||||
|
}
|
||||||
|
elsif ($command eq "s") {
|
||||||
|
cmd_set($arguments, 0);
|
||||||
|
}
|
||||||
|
elsif ($command eq "w") {
|
||||||
|
cmd_write_config_file($arguments);
|
||||||
|
}
|
||||||
|
elsif ($command ne "") {
|
||||||
|
print "unknown command\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
print "($State) > " unless $No_Prompt;
|
||||||
|
STDOUT->flush;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_connect {
|
||||||
|
|
||||||
|
cmd_disconnect() if $State eq "connected";
|
||||||
|
|
||||||
|
my $start_time = time();
|
||||||
|
my $date_string = ctime($start_time);
|
||||||
|
print "$date_string Running pptp $Server $Debug_Flag";
|
||||||
|
system("pptp $Server $Debug_Flag");
|
||||||
|
|
||||||
|
my $interface = "";
|
||||||
|
|
||||||
|
do {
|
||||||
|
sleep 1;
|
||||||
|
$interface = net_interface_up($Net);
|
||||||
|
print ".";
|
||||||
|
} until ($interface || time() > $start_time + $Timeout);
|
||||||
|
|
||||||
|
if (time() > $start_time + $Timeout) {
|
||||||
|
print "timed out after $Timeout sec\n";
|
||||||
|
$State = "disconnected";
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\n";
|
||||||
|
|
||||||
|
my $ifcfg = `ifconfig $interface`;
|
||||||
|
$ifcfg =~ /P-t-P:(.*) Mask/;
|
||||||
|
my $ip = $1;
|
||||||
|
print "setting route to network $Net to interface $interface\n";
|
||||||
|
system("route add -net $Net dev $interface metric 2");
|
||||||
|
|
||||||
|
# Routes are separated by commas
|
||||||
|
my @route = split(/,/, $Route);
|
||||||
|
for my $route (@route) {
|
||||||
|
my $net_flag = "";
|
||||||
|
$net_flag = "-net" if $route =~ /\//;
|
||||||
|
|
||||||
|
print "setting route to $route to interface $interface\n";
|
||||||
|
system("route add $net_flag $route dev $interface");
|
||||||
|
}
|
||||||
|
|
||||||
|
$State = "connected";
|
||||||
|
print "connected\n";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_disconnect {
|
||||||
|
|
||||||
|
return 1 if $State eq "disconnected";
|
||||||
|
|
||||||
|
my $interface = net_interface_up($Net);
|
||||||
|
my $pid_file = "/var/run/$interface.pid";
|
||||||
|
|
||||||
|
# delete the named pipes - XXX this is a bit crude
|
||||||
|
system("rm -f /var/run/pptp/*");
|
||||||
|
|
||||||
|
$State = "disconnected", return 1 unless $interface && -f $pid_file;
|
||||||
|
|
||||||
|
my $pid = `cat $pid_file`;
|
||||||
|
chomp $pid;
|
||||||
|
print "killing pppd($pid)\n";
|
||||||
|
kill("HUP", $pid);
|
||||||
|
print "waiting for pppd to die";
|
||||||
|
do {
|
||||||
|
sleep 1;
|
||||||
|
print ".";
|
||||||
|
}
|
||||||
|
until (kill(0, $pid));
|
||||||
|
|
||||||
|
print "\n";
|
||||||
|
$State = "disconnected";
|
||||||
|
print "disconnected\n";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_list {
|
||||||
|
|
||||||
|
print "Server = $Server\n";
|
||||||
|
print "Network = $Net\n";
|
||||||
|
print "Routes = $Route\n";
|
||||||
|
print "Debug = $Debug_Flag\n";
|
||||||
|
print "No_Prompt = $No_Prompt\n";
|
||||||
|
print "Timeout = $Timeout\n";
|
||||||
|
print "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_help {
|
||||||
|
|
||||||
|
print "Commands are:\n";
|
||||||
|
print "c - initiate PPTP connection\n";
|
||||||
|
print "d - disconnect PPTP\n";
|
||||||
|
print "h - this help message\n";
|
||||||
|
print "l - list current configuration\n";
|
||||||
|
print "q - quite the program\n";
|
||||||
|
print "r - read configuration file\n";
|
||||||
|
print "s - set configuration variable (l for a list)\n";
|
||||||
|
print "w - write the configuration file\n";
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_set {
|
||||||
|
my $input = shift;
|
||||||
|
my $no_replace = shift;
|
||||||
|
|
||||||
|
my ($variable, $value) = split(/\s*=\s*/, $input);
|
||||||
|
|
||||||
|
$variable = "\L$variable";
|
||||||
|
if (! $variable) {
|
||||||
|
print "syntax: s variable = value\n";
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($variable eq "server") {
|
||||||
|
$Server = $value unless $no_replace && $Server;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "network") {
|
||||||
|
$Net = $value unless $no_replace && $Net;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "routes") {
|
||||||
|
$Route = $value unless $no_replace && $Route;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "debug") {
|
||||||
|
$Debug_Flag = $value unless $no_replace && $Debug_Flag;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "no_prompt") {
|
||||||
|
$No_Prompt = $value unless $no_replace && $No_Prompt;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "timeout") {
|
||||||
|
$Timeout = $value unless $no_replace && $Timeout;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "config_file") {
|
||||||
|
$Config_File = $value unless $no_replace && $Config_File;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
print "unknown variable\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_read_config_file {
|
||||||
|
my $file = shift;
|
||||||
|
|
||||||
|
my $config = [];
|
||||||
|
$file = $Config_File unless $file;
|
||||||
|
local *IN;
|
||||||
|
if (!open(IN, $file)) {
|
||||||
|
print "cannot open $file\n";
|
||||||
|
return $config;
|
||||||
|
}
|
||||||
|
|
||||||
|
my @config_file = <IN>;
|
||||||
|
close IN;
|
||||||
|
push @config_file, "\n";
|
||||||
|
chomp @config_file;
|
||||||
|
|
||||||
|
for my $line (@config_file) {
|
||||||
|
next if /\s*#/;
|
||||||
|
|
||||||
|
if ($line =~ /\S/) {
|
||||||
|
$line =~ s/^\s*//;
|
||||||
|
$line =~ s/\s*$//;
|
||||||
|
push @$config, $line;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $config;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd_write_config_file {
|
||||||
|
my $file = shift;
|
||||||
|
|
||||||
|
$file = $Config_File unless $file;
|
||||||
|
local *OUT;
|
||||||
|
if (!open(OUT, ">$file")) {
|
||||||
|
print "cannot open $file\n";
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $oldfh = select OUT;
|
||||||
|
cmd_list();
|
||||||
|
close OUT;
|
||||||
|
select $oldfh;
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub net_interface_up {
|
||||||
|
my $cidr = shift;
|
||||||
|
|
||||||
|
# cidr is net/bits
|
||||||
|
my($net, $nbits) = split(/\//, $cidr);
|
||||||
|
|
||||||
|
# compute the network number
|
||||||
|
my $netnum = netnum($net, $nbits);
|
||||||
|
local(*INTERFACE);
|
||||||
|
open(INTERFACE, "ifconfig|") || die "cannot run ifconfig - $!\n";
|
||||||
|
|
||||||
|
my $interface = "";
|
||||||
|
my @interface = <INTERFACE>;
|
||||||
|
close INTERFACE;
|
||||||
|
for (@interface) {
|
||||||
|
chomp;
|
||||||
|
|
||||||
|
# new interface
|
||||||
|
if (/^[a-zA-Z]/) {
|
||||||
|
if ($interface =~ /(.*) Link.*P-t-P:(.*) Mask/) {
|
||||||
|
my $interface_name = $1;
|
||||||
|
my $ip = $2;
|
||||||
|
return $interface_name
|
||||||
|
if netnum($ip, $nbits) == $netnum;
|
||||||
|
}
|
||||||
|
$interface = "";
|
||||||
|
}
|
||||||
|
$interface .= $_;
|
||||||
|
}
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub netnum {
|
||||||
|
my $net = shift;
|
||||||
|
my $bits = shift;
|
||||||
|
|
||||||
|
my @octets = split(/\./, $net);
|
||||||
|
my $netnum = 0;
|
||||||
|
for my $octet (@octets) {
|
||||||
|
$netnum <<= 8;
|
||||||
|
$netnum |= $octet;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $mask = 0;
|
||||||
|
for (1..$bits) {
|
||||||
|
$mask <<= 1;
|
||||||
|
$mask |= 1;
|
||||||
|
}
|
||||||
|
$mask = $mask << (32-$bits);
|
||||||
|
|
||||||
|
$netnum &= $mask;
|
||||||
|
|
||||||
|
return $netnum;
|
||||||
|
}
|
||||||
255
xpptp_fe.pl
Normal file
255
xpptp_fe.pl
Normal file
@ -0,0 +1,255 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
#
|
||||||
|
# $Id: xpptp_fe.pl,v 1.1 2001/11/29 05:19:10 quozl Exp $
|
||||||
|
#
|
||||||
|
# xpptp_fe.pl, graphical user interface for PPTP configuration
|
||||||
|
# Copyright (C) 2001 Smoot Carl-Mitchell (smoot@tic.com)
|
||||||
|
#
|
||||||
|
# This program is free software; you can redistribute it and/or modify
|
||||||
|
# it under the terms of the GNU General Public License as published by
|
||||||
|
# the Free Software Foundation; either version 2 of the License, or
|
||||||
|
# (at your option) any later version.
|
||||||
|
#
|
||||||
|
# This program is distributed in the hope that it will be useful,
|
||||||
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
# GNU General Public License for more details.
|
||||||
|
#
|
||||||
|
# You should have received a copy of the GNU General Public License
|
||||||
|
# along with this program; if not, write to the Free Software
|
||||||
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
#
|
||||||
|
|
||||||
|
use Tk;
|
||||||
|
use Tk::DirTree;
|
||||||
|
|
||||||
|
=pod
|
||||||
|
TK driver for pptp_fe command script
|
||||||
|
=cut
|
||||||
|
|
||||||
|
=pod
|
||||||
|
Global flags which correspnd to the pptp_fe flags and options
|
||||||
|
=cut
|
||||||
|
|
||||||
|
my $Debug = 0;
|
||||||
|
my $Debug_Flag = "";
|
||||||
|
my $Network = "";
|
||||||
|
my $Server = "";
|
||||||
|
my $Routes = "";
|
||||||
|
my $Get_Current_Config = 0;
|
||||||
|
|
||||||
|
=pod
|
||||||
|
|
||||||
|
Start up pptp_fe and connect its input and output to the TK frontend.
|
||||||
|
All I/O is done in raw mode, so the reads and writes are atomic and
|
||||||
|
unbuffered.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
pipe OUTPUT_READ, OUTPUT_WRITE;
|
||||||
|
pipe COMMAND_READ, COMMAND_WRITE;
|
||||||
|
|
||||||
|
my $Child_Pid = fork();
|
||||||
|
die "cannot fork - $!\n" if $Child_Pid == -1;
|
||||||
|
|
||||||
|
if ($Child_Pid) { # parent
|
||||||
|
close OUTPUT_WRITE;
|
||||||
|
close COMMAND_READ;
|
||||||
|
}
|
||||||
|
else { # child
|
||||||
|
close OUTPUT_READ;
|
||||||
|
close COMMAND_WRITE;
|
||||||
|
|
||||||
|
open(STDIN, "<&COMMAND_READ");
|
||||||
|
open(STDOUT, ">&OUTPUT_WRITE");
|
||||||
|
|
||||||
|
exec("pptp_fe -p");
|
||||||
|
}
|
||||||
|
|
||||||
|
=pod
|
||||||
|
The main window which present the various pptp_fe options.
|
||||||
|
|
||||||
|
The window is composed of:
|
||||||
|
|
||||||
|
Server name
|
||||||
|
Network number
|
||||||
|
Routes
|
||||||
|
Connect Button Disconnect Button Write Config Button Quit Button
|
||||||
|
=cut
|
||||||
|
|
||||||
|
my $Main = MainWindow->new();
|
||||||
|
$Main->Label(-text => "PPTP")->pack;
|
||||||
|
|
||||||
|
my $Server_Frame = $Main->Frame->pack(-fill => 'x',
|
||||||
|
-padx => 5,
|
||||||
|
-pady => 5);
|
||||||
|
|
||||||
|
$Server_Frame->Label(-text => "Remote PPTP Host")->pack(-side => "left");
|
||||||
|
$Server_Frame->Entry(
|
||||||
|
-text => "Host",
|
||||||
|
-width => 30,
|
||||||
|
-textvariable => \$Server,
|
||||||
|
)->pack(-side => "left");
|
||||||
|
|
||||||
|
|
||||||
|
my $Net_Frame = $Main->Frame->pack(-fill => 'x',
|
||||||
|
-padx => 5,
|
||||||
|
-pady => 5);
|
||||||
|
|
||||||
|
=pod
|
||||||
|
Network number entry box. This is the argument to the the -n flag
|
||||||
|
=cut
|
||||||
|
|
||||||
|
$Net_Frame->Label(-text => "Network Number")->pack(-side => "left");
|
||||||
|
$Net_Frame->Entry(
|
||||||
|
-text => "Network",
|
||||||
|
-width => 15,
|
||||||
|
-textvariable => \$Network,
|
||||||
|
)->pack(-side => "left");
|
||||||
|
|
||||||
|
=pod
|
||||||
|
Additional static routes (-r) flag
|
||||||
|
=cut
|
||||||
|
|
||||||
|
my $Route_Frame = $Main->Frame->pack(
|
||||||
|
-fill => 'x',
|
||||||
|
-padx => 5,
|
||||||
|
-pady => 5);
|
||||||
|
|
||||||
|
$Route_Frame->Label(-text => "Routes")->pack(-side => "left");
|
||||||
|
|
||||||
|
$Route_Frame->Entry(
|
||||||
|
-text => "Routes",
|
||||||
|
-width => 30,
|
||||||
|
-textvariable => \$Routes
|
||||||
|
)->pack(
|
||||||
|
-side => "left",
|
||||||
|
-padx => 5,
|
||||||
|
-pady => 5);
|
||||||
|
|
||||||
|
=pod
|
||||||
|
Buttons
|
||||||
|
|
||||||
|
Connect - Connect to a remote PPTP server
|
||||||
|
|
||||||
|
Disconnect - Disconnect from the remote PPTP server
|
||||||
|
|
||||||
|
Write - Write a configuration file
|
||||||
|
|
||||||
|
Quit - Terminates the running pptp daemon and pptp_fe program.
|
||||||
|
=cut
|
||||||
|
|
||||||
|
my $Button_Frame = $Main->Frame->pack(-fill => 'x', -pady => 5);
|
||||||
|
|
||||||
|
my $Disconnect_Button;
|
||||||
|
my $Connect_Button;
|
||||||
|
my $Read_Button;
|
||||||
|
my $Write_Button;
|
||||||
|
my $Quit_Button;
|
||||||
|
|
||||||
|
$Connect_Button = $Button_Frame->Button(
|
||||||
|
-text => "Connect",
|
||||||
|
-command =>
|
||||||
|
sub {
|
||||||
|
update_config();
|
||||||
|
syswrite(COMMAND_WRITE, "c\n");
|
||||||
|
|
||||||
|
$Connect_Button->configure(-state => "disabled");
|
||||||
|
$Disconnect_Button->configure(-state => "normal");
|
||||||
|
},
|
||||||
|
)->pack(-side => "left", -pady => 5, -padx => 5);
|
||||||
|
|
||||||
|
$Disconnect_Button = $Button_Frame->Button(
|
||||||
|
-text => "Disconnect",
|
||||||
|
-state => "disabled",
|
||||||
|
-command =>
|
||||||
|
sub {
|
||||||
|
syswrite(COMMAND_WRITE, "d\n");
|
||||||
|
|
||||||
|
$Connect_Button->configure(-state => "normal");
|
||||||
|
$Disconnect_Button->configure(-state => "disabled");
|
||||||
|
}
|
||||||
|
)->pack(-side => "left", -pady => 5, -padx => 5);
|
||||||
|
|
||||||
|
$Write_Button = $Button_Frame->Button(
|
||||||
|
-text => "Write Config",
|
||||||
|
-command =>
|
||||||
|
sub {
|
||||||
|
syswrite(COMMAND_WRITE, "w\n");
|
||||||
|
|
||||||
|
}
|
||||||
|
)->pack(-side => "left", -pady => 5, -padx => 5);
|
||||||
|
|
||||||
|
$Quit_Button = $Button_Frame->Button(
|
||||||
|
-text => "Quit",
|
||||||
|
-command =>
|
||||||
|
sub {
|
||||||
|
syswrite(COMMAND_WRITE, "q\n");
|
||||||
|
|
||||||
|
$Connect_Button->configure(-state => "disabled");
|
||||||
|
$Disconnect_Button->configure(-state => "disabled");
|
||||||
|
$Quit_Button->configure(-state => "disabled");
|
||||||
|
}
|
||||||
|
)->pack(-side => "left", -pady => 5, -padx => 5);
|
||||||
|
|
||||||
|
my $Log_Window = $Main->Toplevel;
|
||||||
|
$Log_Window->title("PPTP Log");
|
||||||
|
|
||||||
|
my $Log_Widget = $Log_Window->Text(
|
||||||
|
-height => 20,
|
||||||
|
-width => 80,
|
||||||
|
)->pack;
|
||||||
|
|
||||||
|
|
||||||
|
$Log_Widget->fileevent(OUTPUT_READ, "readable", sub {
|
||||||
|
my $in = "";
|
||||||
|
my $n = sysread(OUTPUT_READ, $in, 1024);
|
||||||
|
if ($n == 0) {
|
||||||
|
close OUTPUT_READ;
|
||||||
|
$Main->destroy;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!$Get_Current_Config) {
|
||||||
|
$Log_Widget->insert("end", $in);
|
||||||
|
$Log_Widget->see("end");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$Get_Current_Config = 0;
|
||||||
|
|
||||||
|
for my $line (split("\n", $in)) {
|
||||||
|
next unless $line =~ /\S/;
|
||||||
|
|
||||||
|
my ($variable, $value) = split(/\s*=\s*/, $line);
|
||||||
|
$variable = "\L$variable";
|
||||||
|
|
||||||
|
if ($variable eq "server") {
|
||||||
|
$Server = $value;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "network") {
|
||||||
|
$Network = $value;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "routes") {
|
||||||
|
$Routes = $value;
|
||||||
|
}
|
||||||
|
elsif ($variable eq "debug") {
|
||||||
|
$Debug = $value;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
});
|
||||||
|
|
||||||
|
syswrite(COMMAND_WRITE, "l\n");
|
||||||
|
$Get_Current_Config = 1;
|
||||||
|
|
||||||
|
MainLoop;
|
||||||
|
|
||||||
|
sub update_config {
|
||||||
|
|
||||||
|
syswrite(COMMAND_WRITE, "s server = $Server\n");
|
||||||
|
syswrite(COMMAND_WRITE, "s network = $Network\n");
|
||||||
|
syswrite(COMMAND_WRITE, "s routes = $Routes\n");
|
||||||
|
syswrite(COMMAND_WRITE, "s debug = $Debug_Flag\n");
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user