Current File : //usr/share/webmin/pptp-client/pptp-client-lib.pl

# 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, 'require-', 'no' ],
	      [ 'mppe-40', 1, 'require-', 'no' ],
	      [ 'mppe-128', 1, 'require-', 'no' ],
	      [ 'mppe-stateful', 0, '', 'no' ],
	    );

# 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 $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($o->[2].$o->[0], $opts);
		local $o1 = &find($o->[2].$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
{
if ($in{'mppe_mode'}) {
	# Parse new-style options
	foreach my $opt (@new_mppe) {
		my $req = $opt->[2].$opt->[0];
		my $no = $opt->[3].$opt->[0];
		if ($in{$opt->[0]} == 2) {
			&save_ppp_option($_[0], $_[1], $req,
					 { 'name' => $req });
			&save_ppp_option($_[0], $_[1], $no, undef);
			}
		elsif ($in{$opt->[0]} == 1) {
			&save_ppp_option($_[0], $_[1], $req, undef);
			&save_ppp_option($_[0], $_[1], $no, undef);
			}
		else {
			&save_ppp_option($_[0], $_[1], $req, undef);
			&save_ppp_option($_[0], $_[1], $no,
					 { 'name' => $no });
			}
		}
	}
else {
	# Parse old-style options
	foreach my $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;