You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
371 lines
7.9 KiB
371 lines
7.9 KiB
#!/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;
|
|
}
|