summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAron Griffis <agriffis@gentoo.org>2003-02-26 23:31:46 +0000
committerAron Griffis <agriffis@gentoo.org>2003-02-26 23:31:46 +0000
commit13d520b717600a874375adbb038057c317ae2f56 (patch)
tree11356a9e15d7e78476ce1f5de87c1ad17fbc9b4e /net-dialup/pptpclient
parentadd arm sources ebuild (diff)
downloadgentoo-2-13d520b717600a874375adbb038057c317ae2f56.tar.gz
gentoo-2-13d520b717600a874375adbb038057c317ae2f56.tar.bz2
gentoo-2-13d520b717600a874375adbb038057c317ae2f56.zip
update to 1.2.0
Diffstat (limited to 'net-dialup/pptpclient')
-rw-r--r--net-dialup/pptpclient/ChangeLog9
-rw-r--r--net-dialup/pptpclient/files/digest-pptpclient-1.2.01
-rw-r--r--net-dialup/pptpclient/files/options.pptp34
-rw-r--r--net-dialup/pptpclient/files/pptp-command865
-rw-r--r--net-dialup/pptpclient/files/pptp_fe.pl370
-rw-r--r--net-dialup/pptpclient/files/xpptp_fe.pl255
-rw-r--r--net-dialup/pptpclient/pptpclient-1.2.0.ebuild38
7 files changed, 1571 insertions, 1 deletions
diff --git a/net-dialup/pptpclient/ChangeLog b/net-dialup/pptpclient/ChangeLog
index f69e714496a8..cc8aa4f3723a 100644
--- a/net-dialup/pptpclient/ChangeLog
+++ b/net-dialup/pptpclient/ChangeLog
@@ -1,6 +1,13 @@
# ChangeLog for net-dialup/pptpclient
# Copyright 2002-2003 Gentoo Technologies, Inc.; Distributed under the GPL v2
-# $Header: /var/cvsroot/gentoo-x86/net-dialup/pptpclient/ChangeLog,v 1.5 2003/02/12 07:53:49 vapier Exp $
+# $Header: /var/cvsroot/gentoo-x86/net-dialup/pptpclient/ChangeLog,v 1.6 2003/02/26 23:31:46 agriffis Exp $
+
+*pptpclient-1.2.0 (26 Feb 2003)
+
+ 26 Feb 2003; Aron Griffis <agriffis@gentoo.org> pptpclient-1.2.0.ebuild,
+ files/options.pptp, files/pptp-command, files/pptp_fe.pl, files/xpptp_fe.pl:
+ Update to version 1.2.0. Since this version doesn't include the RH-specific
+ pieces, also include those now in our files directory.
*pptpclient-1.1.0-r1 (14 Nov 2002)
diff --git a/net-dialup/pptpclient/files/digest-pptpclient-1.2.0 b/net-dialup/pptpclient/files/digest-pptpclient-1.2.0
new file mode 100644
index 000000000000..0d8422644dc2
--- /dev/null
+++ b/net-dialup/pptpclient/files/digest-pptpclient-1.2.0
@@ -0,0 +1 @@
+MD5 d6e5072c62046abc14c5b356d33d52cb pptp-linux-1.2.0.tar.gz 211258
diff --git a/net-dialup/pptpclient/files/options.pptp b/net-dialup/pptpclient/files/options.pptp
new file mode 100644
index 000000000000..7111f0cb439c
--- /dev/null
+++ b/net-dialup/pptpclient/files/options.pptp
@@ -0,0 +1,34 @@
+#
+# 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
+#
+mppe-40
+mppe-128
+mppe-stateless
+
+#
+# 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
diff --git a/net-dialup/pptpclient/files/pptp-command b/net-dialup/pptpclient/files/pptp-command
new file mode 100644
index 000000000000..b3b80a4d3b09
--- /dev/null
+++ b/net-dialup/pptpclient/files/pptp-command
@@ -0,0 +1,865 @@
+#!/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.1 2003/02/26 23:31:46 agriffis 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;
+ 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;
+}
diff --git a/net-dialup/pptpclient/files/pptp_fe.pl b/net-dialup/pptpclient/files/pptp_fe.pl
new file mode 100644
index 000000000000..ca49b41640d8
--- /dev/null
+++ b/net-dialup/pptpclient/files/pptp_fe.pl
@@ -0,0 +1,370 @@
+#!/usr/bin/perl
+#
+# $Id: pptp_fe.pl,v 1.1 2003/02/26 23:31:46 agriffis 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;
+}
diff --git a/net-dialup/pptpclient/files/xpptp_fe.pl b/net-dialup/pptpclient/files/xpptp_fe.pl
new file mode 100644
index 000000000000..354569b11fd5
--- /dev/null
+++ b/net-dialup/pptpclient/files/xpptp_fe.pl
@@ -0,0 +1,255 @@
+#!/usr/bin/perl -w
+#
+# $Id: xpptp_fe.pl,v 1.1 2003/02/26 23:31:46 agriffis Exp $
+#
+# xpptp_fe.pl.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.pl command script
+=cut
+
+=pod
+Global flags which correspnd to the pptp_fe.pl 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.pl 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.pl -p");
+}
+
+=pod
+The main window which present the various pptp_fe.pl 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.pl 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");
+}
diff --git a/net-dialup/pptpclient/pptpclient-1.2.0.ebuild b/net-dialup/pptpclient/pptpclient-1.2.0.ebuild
new file mode 100644
index 000000000000..359da8b72da6
--- /dev/null
+++ b/net-dialup/pptpclient/pptpclient-1.2.0.ebuild
@@ -0,0 +1,38 @@
+# Copyright 1999-2003 Gentoo Technologies, Inc.
+# Distributed under the terms of the GNU General Public License v2
+# $Header: /var/cvsroot/gentoo-x86/net-dialup/pptpclient/pptpclient-1.2.0.ebuild,v 1.1 2003/02/26 23:31:46 agriffis Exp $
+
+MY_P=pptp-linux-${PV}
+S=${WORKDIR}/${MY_P}
+DESCRIPTION="Linux client for PPTP"
+HOMEPAGE="http://pptpclient.sourceforge.net/"
+SRC_URI="mirror://sourceforge/pptpclient/${MY_P}.tar.gz"
+
+SLOT="0"
+LICENSE="GPL-2"
+KEYWORDS="~x86 ~ppc"
+IUSE="tcltk"
+
+DEPEND="net-dialup/ppp
+ sys-devel/perl
+ tcltk? ( dev-perl/perl-tk )"
+
+src_compile() {
+ make || die "make failed"
+}
+
+src_install() {
+ dosbin pptp
+ dodoc AUTHORS COPYING ChangeLog DEVELOPERS NEWS README TODO USING
+ dodoc Documentation/*
+ dodoc Reference/*
+ dodir /etc/pptp.d
+
+ # The current version of pptp-linux doesn't include the
+ # RH-specific portions, so include them ourselves.
+ cd ${FILESDIR}
+ insinto /etc/ppp
+ doins options.pptp
+ dosbin pptp-command pptp_fe.pl
+ use tcltk && dosbin xpptp_fe.pl
+}