commit dab1debd2538c650034f030a707d6c20f60ac50c6ab26f5736c330dece74da9d Author: OBS User unknown Date: Mon Jan 15 23:33:21 2007 +0000 OBS-URL: https://build.opensuse.org/package/show/openSUSE:Factory/pptp?expand=0&rev=1 diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..9b03811 --- /dev/null +++ b/.gitattributes @@ -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 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..57affb6 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.osc diff --git a/options.pptp b/options.pptp new file mode 100644 index 0000000..594b072 --- /dev/null +++ b/options.pptp @@ -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 diff --git a/pptp-1.7.1.tar.bz2 b/pptp-1.7.1.tar.bz2 new file mode 100644 index 0000000..fbf0fa5 --- /dev/null +++ b/pptp-1.7.1.tar.bz2 @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:fdd1dcaa8ae9eea18c380306254aa671e97db9b8cd348fb18a5ad867fb5497fe +size 180858 diff --git a/pptp-command b/pptp-command new file mode 100644 index 0000000..8f1b62a --- /dev/null +++ b/pptp-command @@ -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 +# +# Ask the user and return true for yes, false for no +# +sub yesno($) { + my $prompt = $_[0]; + while(1) { + print "\n$prompt [Y/n]:"; + my $choice = ; + 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 +# +# Ask the user and return the answer, if cr +# +sub QueryUser($$) { + my ($prompt, $default) = @_; + + print "$prompt"; + print " [$default]" if defined $default; + print ": "; + my $answer = ; + 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 +# +# Adds a new tunnel with name , server ip address , +# and using the CHAP secret determined by local name and remote +# name . +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 +# +# Deletes the tunnel named +# +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 +# +# If is a symlink +# 1. break the link +# 2. copy the contents of the file pointed to do +# +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 +# +# Rotates config files. +# +# - full path of the config file +# - full path of the file being rotated in +# - 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 = ; + 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 = ; + 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 = ) { + 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/pptp-makefile.patch b/pptp-makefile.patch new file mode 100644 index 0000000..a3e61e8 --- /dev/null +++ b/pptp-makefile.patch @@ -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) + diff --git a/pptp.changes b/pptp.changes new file mode 100644 index 0000000..10cc77f --- /dev/null +++ b/pptp.changes @@ -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. + diff --git a/pptp.spec b/pptp.spec new file mode 100644 index 0000000..7048fb7 --- /dev/null +++ b/pptp.spec @@ -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 + + Christoph Lameter + Gordon Chaffee + mulix + James Cameron + Rein Klazes + Thomas Quinot + Rhialto + Scott Venier + Jeff Wiedemeier + Yura Zotov + +%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. diff --git a/pptp_fe.pl b/pptp_fe.pl new file mode 100644 index 0000000..c041a63 --- /dev/null +++ b/pptp_fe.pl @@ -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 = ; + 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 = ; + 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/ready b/ready new file mode 100644 index 0000000..473a0f4 diff --git a/xpptp_fe.pl b/xpptp_fe.pl new file mode 100644 index 0000000..e6af280 --- /dev/null +++ b/xpptp_fe.pl @@ -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"); +}