Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
openSUSE:12.2
pptp
pptp_fe.pl
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File pptp_fe.pl of Package pptp
#!/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; }
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor