Viewing file:  pptp-client-lib.pl (8.55 KB) -rwxr-xr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
# pptp-client-lib.pl
# XXX help page
BEGIN { push(@INC, ".."); };
use WebminCore;
&init_config();
do 'secrets-lib.pl';
# list_tunnels()
# Returns a list of the details of configured tunnels, in the format used
# by the pptp-command script
sub list_tunnels
{
local ($f, @rv);
opendir(DIR, $config{'peers_dir'});
while($f = readdir(DIR)) {
next if ($f =~ /^\./ || $f eq "__default");
local @opts = &parse_ppp_options("$config{'peers_dir'}/$f");
local ($pptp) = grep { $_->{'comment'} =~ /^PPTP/ } @opts;
if ($pptp) {
# Is a tunnel config .. add it
push(@rv, { 'name' => $f,
'file' => "$config{'peers_dir'}/$f",
'opts' => \@opts });
}
}
closedir(DIR);
return @rv;
}
# parse_ppp_options(file)
sub parse_ppp_options
{
local @rv;
local $lnum = 0;
open(OPTS, $_[0]);
while(<OPTS>) {
s/\r|\n//g;
if (/^#\s*(.*)/) {
# A comment, used to store meta-information
push(@rv, { 'comment' => $1,
'file' => $_[0],
'line' => $lnum,
'index' => scalar(@rv) });
}
elsif (/^([0-9\.]+):([0-9\.]+)/) {
# A local/remote IP specification
push(@rv, { 'local' => $1,
'remote' => $2,
'file' => $_[0],
'line' => $lnum,
'index' => scalar(@rv) });
}
elsif (/^([^# ]*)\s*([^#]*)/) {
# A PPP options directive
push(@rv, { 'name' => $1,
'value' => $2,
'file' => $_[0],
'line' => $lnum,
'index' => scalar(@rv) });
}
$lnum++;
}
close(OPTS);
return @rv;
}
# find(name, &config)
sub find
{
local @rv = grep { lc($_->{'name'}) eq lc($_[0]) } @{$_[1]};
return wantarray ? @rv : $rv[0];
}
# save_ppp_option(&config, file, &old|name, &new)
sub save_ppp_option
{
local $ol = ref($_[2]) || !defined($_[2]) ? $_[2] : &find($_[2], $_[0]);
local $nw = $_[3];
local $lref = &read_file_lines($_[1]);
local $line;
if ($nw) {
if ($nw->{'local'}) {
$line = $nw->{'local'}.":".$nw->{'remote'};
}
elsif ($nw->{'comment'}) {
$line = "# ".$nw->{'comment'};
}
else {
$line = $nw->{'name'};
$line .= " $nw->{'value'}" if ($nw->{'value'} ne "");
}
}
if ($ol && $nw) {
$lref->[$ol->{'line'}] = $line;
}
elsif ($ol) {
splice(@$lref, $ol->{'line'}, 1);
local $c;
foreach $c (@{$_[0]}) {
$c->{'line'}-- if ($c->{'line'} > $ol->{'line'});
}
}
elsif ($nw) {
push(@$lref, $line);
}
}
# list_connected()
# Returns a list of the names of tunnels that appear to be active. May include
# other ppp calls as well
sub list_connected
{
&foreign_require("proc", "proc-lib.pl");
local @rv;
foreach $p (&proc::list_processes()) {
if ($p->{'args'} =~ /pppd\s.*call\s+(.*\S+)/) {
push(@rv, [ $1, $p->{'pid'} ]);
if ($1 eq $config{'tunnel'}) {
$rv[$#rv]->[2] = $config{'iface'};
}
}
}
return @rv;
}
# parse_comments(&tunnel)
sub parse_comments
{
foreach $c (@{$_[0]->{'opts'}}) {
if ($c->{'comment'} =~ /Server IP: (\S+)/) {
$_[0]->{'server'} = $1;
$_[0]->{'server_c'} = $c;
}
elsif ($c->{'comment'} =~ /Route: (.*)/) {
push(@{$_[0]->{'routes'}}, $1);
push(@{$_[0]->{'routes_c'}}, $c);
}
}
}
@old_mppe = ( 'mppe-40', 'mppe-128', 'mppe-stateless' );
@new_mppe = ( [ 'mppe', 0 ], [ 'mppe-40', 1 ], [ 'mppe-128', 1 ],
[ 'mppe-stateful', 0 ] );
# mppe_options_form(&opts)
# Show a form for editing MPPE-related PPP options
sub mppe_options_form
{
# Get the PPPd version. Only those above 2.4.2 have built-in MPPE support
local $out = `pppd --help 2>&1`;
local $mppe_mode = &mppe_support();
print "<input type=hidden name=mppe_mode value='$mppe_mode'>\n";
local $opts = $_[0];
if ($mppe_mode) {
# Show new MPPE options
local $o;
foreach $o (@new_mppe) {
local $o0 = &find("require-".$o->[0], $opts);
local $o1 = &find("no".$o->[0], $opts);
local $mode = $o0 ? 2 : $o1 ? 0 : 1;
print "<tr> <td><b>",$text{'mppe_'.$o->[0]},"</b></td>\n";
print "<td colspan=3>\n";
printf "<input type=radio name=%s value=2 %s> %s\n",
$o->[0], $mode == 2 ? "checked" : "", $text{'mppe_m2'};
printf "<input type=radio name=%s value=1 %s> %s (%s)\n",
$o->[0], $mode == 1 ? "checked" : "", $text{'default'},
$o->[1] ? $text{'mppe_d1'} : $text{'mppe_d0'};
printf "<input type=radio name=%s value=0 %s> %s\n",
$o->[0], $mode == 0 ? "checked" : "", $text{'mppe_m0'};
print "</td> </tr>\n";
}
local @anyold = grep { &find($_, $opts) } @old_mppe;
if (@anyold) {
print "<tr> <td colspan=4 align=center>",&text('mppe_old',
"<tt>".join(" ", @anyold)."</tt>"),"</td> </tr>\n";
}
}
else {
# Show old MPPE options
$i = 0;
foreach $o (@old_mppe) {
print "<tr>\n" if ($i%2 == 0);
local $v = &find($o, $opts);
print "<td><b>",$text{'mppe_'.$o},"</b></td> <td>\n";
printf "<input type=radio name=$o value=1 %s> %s\n",
$v ? "checked" : "", $text{'yes'};
printf "<input type=radio name=$o value=0 %s> %s</td>\n",
$v ? "" : "checked", $text{'no'};
print "</tr>\n" if ($i%2 == 1);
$i++;
}
local @anynew = grep { &find($_, $opts) }
( map { 'require-'.$_->[0] } @new_mppe ),
( map { 'no'.$_->[0] } @new_mppe );
if (@anynew) {
print "<tr> <td colspan=4 align=center>",&text('mppe_new',
"<tt>".join(" ", @anynew)."</tt>"),"</td> </tr>\n";
}
print "</tr>\n";
}
}
# parse_mppe_options(&config, file)
sub parse_mppe_options
{
local $o;
if ($in{'mppe_mode'}) {
# Parse new-style options
foreach $o (map { $_->[0] } @new_mppe) {
if ($in{$o} == 2) {
&save_ppp_option($_[0], $_[1], "require-$o",
{ 'name' => "require-$o" });
&save_ppp_option($_[0], $_[1], "no$o", undef);
}
elsif ($in{$o} == 1) {
&save_ppp_option($_[0], $_[1], "require-$o", undef);
&save_ppp_option($_[0], $_[1], "no$o", undef);
}
else {
&save_ppp_option($_[0], $_[1], "require-$o", undef);
&save_ppp_option($_[0], $_[1], "no$o",
{ 'name' => "no$o" });
}
}
}
else {
# Parse old-style options
foreach $o (@old_mppe) {
&save_ppp_option($_[0], $_[1], $o,
$in{$o} ? { 'name' => $o } : undef);
}
}
}
# mppe_support()
# Returns 1 if the PPP daemon supports new-style MPPE options (version 2.4.2+,
# 0 if might only support the old options)
sub mppe_support
{
local $out = `pppd --help 2>&1`;
local $vers;
if ($out =~ /version\s+(\S+)/i) {
$vers = $1;
}
if ($vers =~ /^(\d+)/ && $1 > 2 ||
$vers =~ /^(\d+)\.(\d+)/ && $1 == 2 && $2 > 4 ||
$vers =~ /^(\d+)\.(\d+)\.(\d+)/ && $1 == 2 && $2 == 4 && $3 >= 2) {
return 1;
}
return 0;
}
# get_pppd_version(&out)
sub get_pppd_version
{
local $out = `pppd --help 2>&1`;
${$_[0]} = $out;
return $out =~ /version\s+(\S+)/i ? $1 : undef;
}
# connect_tunnel(&tunnel)
# Attempts to open some tunnel. Returns either :
# 1, iface-name, iface-address, iface-ptp
# 0, error-message
sub connect_tunnel
{
local $tunnel = $_[0];
&foreign_require("net", "net-lib.pl");
# Run the PPTP command, and wait for a new pppN interface to come up
local %sifaces = map { $_->{'fullname'}, $_->{'address'} } &get_ppp_ifaces();
local $start = time();
local $temp = &tempname();
&system_logged("modprobe ip_gre >/dev/null 2>&1");
&system_logged("$config{'pptp'} ".quotemeta($tunnel->{'server'})." call ".
quotemeta($tunnel->{'name'})." >$temp 2>&1 </dev/null &");
local $newiface;
LOOP: while(time() - $start < $config{'timeout'}) {
sleep(1);
local @nifaces = &get_ppp_ifaces();
local $i;
foreach $i (@nifaces) {
if (!$sifaces{$i->{'fullname'}}) {
$newiface = $i;
last LOOP;
}
}
}
local $tempout = `cat $temp`;
unlink($temp);
# Find out if we were connected, or if it failed
if ($newiface) {
# It worked! Add the routes
local (@rout, @rcmd);
if (@{$tunnel->{'routes'}}) {
local @routes = &net::list_routes();
local ($defroute) = grep { $_->{'dest'} eq '0.0.0.0' } @routes;
local $oldgw = $defroute->{'gateway'} if ($defroute);
foreach $r (@{$tunnel->{'routes'}}) {
$cmd = "route $r";
$cmd =~ s/TUNNEL_DEV/$newiface->{'fullname'}/g;
$cmd =~ s/DEF_GW/$oldgw/g;
$cmd =~ s/GW/$newiface->{'ptp'}/g;
push(@rcmd, $cmd);
$out = &backquote_logged("$cmd 2>&1 </dev/null");
push(@rout, $out);
}
}
return (1, $newiface->{'fullname'}, $newiface->{'address'},
$newiface->{'ptp'}, \@rcmd, \@rout);
}
else {
# Must have timed out due to a failure
&foreign_require("syslog", "syslog-lib.pl");
local $sysconf = &syslog::get_config();
local $c;
local $logs;
foreach $c (@$sysconf) {
next if ($c->{'tag'} || !$c->{'file'} || !-f $c->{'file'});
local @st = stat($c->{'file'});
if ($st[9] > $start) {
# Was modified since start .. but by ppp or pptp?
local $tail = `tail -10 '$c->{'file'}'`;
if ($tail =~ /ppp|pptp/) {
$logs = $tail;
last;
}
}
}
return (0, $tempout.$logs || "No logged error messages found");
}
}
sub get_ppp_ifaces
{
return grep { $_->{'fullname'} =~ /^ppp(\d+)$/ &&
$_->{'up'} && $_->{'address'} } &net::active_interfaces();
}
1;
|