pptp-client/pptp-client-lib.pl

   1 # pptp-client-lib.pl
   2 # XXX help page
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 &init_config();
   7 do 'secrets-lib.pl';
   8
   9 # list_tunnels()
  10 # Returns a list of the details of configured tunnels, in the format used
  11 # by the pptp-command script
  12 sub list_tunnels
  13 {
  14 local ($f, @rv);
  15 opendir(DIR, $config{'peers_dir'});
  16 while($f = readdir(DIR)) {
  17         next if ($f =~ /^\./ || $f eq "__default");
  18         local @opts = &parse_ppp_options("$config{'peers_dir'}/$f");
  19         local ($pptp) = grep { $_->{'comment'} =~ /^PPTP/ } @opts;
  20         if ($pptp) {
  21                 # Is a tunnel config .. add it
  22                 push(@rv, { 'name' => $f,
  23                             'file' => "$config{'peers_dir'}/$f",
  24                             'opts' => \@opts });
  25                 }
  26         }
  27 closedir(DIR);
  28 return @rv;
  29 }
  30
  31 # parse_ppp_options(file)
  32 sub parse_ppp_options
  33 {
  34 local @rv;
  35 local $lnum = 0;
  36 open(OPTS, $_[0]);
  37 while(<OPTS>) {
  38         s/\r|\n//g;
  39         if (/^#\s*(.*)/) {
  40                 # A comment, used to store meta-information
  41                 push(@rv, { 'comment' => $1,
  42                             'file' => $_[0],
  43                             'line' => $lnum,
  44                             'index' => scalar(@rv) });
  45                 }
  46         elsif (/^([0-9\.]+):([0-9\.]+)/) {
  47                 # A local/remote IP specification
  48                 push(@rv, { 'local' => $1,
  49                             'remote' => $2,
  50                             'file' => $_[0],
  51                             'line' => $lnum,
  52                             'index' => scalar(@rv) });
  53                 }
  54         elsif (/^([^# ]*)\s*([^#]*)/) {
  55                 # A PPP options directive
  56                 push(@rv, { 'name' => $1,
  57                             'value' => $2,
  58                             'file' => $_[0],
  59                             'line' => $lnum,
  60                             'index' => scalar(@rv) });
  61                 }
  62         $lnum++;
  63         }
  64 close(OPTS);
  65 return @rv;
  66 }
  67
  68 # find(name, &config)
  69 sub find
  70 {
  71 local @rv = grep { lc($_->{'name'}) eq lc($_[0]) } @{$_[1]};
  72 return wantarray ? @rv : $rv[0];
  73 }
  74
  75 # save_ppp_option(&config, file, &old|name, &new)
  76 sub save_ppp_option
  77 {
  78 local $ol = ref($_[2]) || !defined($_[2]) ? $_[2] : &find($_[2], $_[0]);
  79 local $nw = $_[3];
  80 local $lref = &read_file_lines($_[1]);
  81 local $line;
  82 if ($nw) {
  83         if ($nw->{'local'}) {
  84                 $line = $nw->{'local'}.":".$nw->{'remote'};
  85                 }
  86         elsif ($nw->{'comment'}) {
  87                 $line = "# ".$nw->{'comment'};
  88                 }
  89         else {
  90                 $line = $nw->{'name'};
  91                 $line .= " $nw->{'value'}" if ($nw->{'value'} ne "");
  92                 }
  93         }
  94 if ($ol && $nw) {
  95         $lref->[$ol->{'line'}] = $line;
  96         }
  97 elsif ($ol) {
  98         splice(@$lref, $ol->{'line'}, 1);
  99         local $c;
 100         foreach $c (@{$_[0]}) {
 101                 $c->{'line'}-- if ($c->{'line'} > $ol->{'line'});
 102                 }
 103         }
 104 elsif ($nw) {
 105         push(@$lref, $line);
 106         }
 107 }
 108
 109 # list_connected()
 110 # Returns a list of the names of tunnels that appear to be active. May include
 111 # other ppp calls as well
 112 sub list_connected
 113 {
 114 &foreign_require("proc", "proc-lib.pl");
 115 local @rv;
 116 foreach $p (&proc::list_processes()) {
 117         if ($p->{'args'} =~ /pppd\s.*call\s+(.*\S+)/) {
 118                 push(@rv, [ $1, $p->{'pid'} ]);
 119                 if ($1 eq $config{'tunnel'}) {
 120                         $rv[$#rv]->[2] = $config{'iface'};
 121                         }
 122                 }
 123         }
 124 return @rv;
 125 }
 126
 127 # parse_comments(&tunnel)
 128 sub parse_comments
 129 {
 130 foreach $c (@{$_[0]->{'opts'}}) {
 131         if ($c->{'comment'} =~ /Server IP: (\S+)/) {
 132                 $_[0]->{'server'} = $1;
 133                 $_[0]->{'server_c'} = $c;
 134                 }
 135         elsif ($c->{'comment'} =~ /Route: (.*)/) {
 136                 push(@{$_[0]->{'routes'}}, $1);
 137                 push(@{$_[0]->{'routes_c'}}, $c);
 138                 }
 139         }
 140 }
 141
 142 @old_mppe = ( 'mppe-40', 'mppe-128', 'mppe-stateless' );
 143 @new_mppe = ( [ 'mppe', 0 ], [ 'mppe-40', 1 ], [ 'mppe-128', 1 ],
 144               [ 'mppe-stateful', 0 ] );
 145
 146 # mppe_options_form(&opts)
 147 # Show a form for editing MPPE-related PPP options
 148 sub mppe_options_form
 149 {
 150 # Get the PPPd version. Only those above 2.4.2 have built-in MPPE support
 151 local $out = `pppd --help 2>&1`;
 152 local $mppe_mode = &mppe_support();
 153 print "<input type=hidden name=mppe_mode value='$mppe_mode'>\n";
 154
 155 local $opts = $_[0];
 156 if ($mppe_mode) {
 157         # Show new MPPE options
 158         local $o;
 159         foreach $o (@new_mppe) {
 160                 local $o0 = &find("require-".$o->[0], $opts);
 161                 local $o1 = &find("no".$o->[0], $opts);
 162                 local $mode = $o0 ? 2 : $o1 ? 0 : 1;
 163                 print "<tr> <td><b>",$text{'mppe_'.$o->[0]},"</b></td>\n";
 164                 print "<td colspan=3>\n";
 165                 printf "<input type=radio name=%s value=2 %s> %s\n",
 166                         $o->[0], $mode == 2 ? "checked" : "", $text{'mppe_m2'};
 167                 printf "<input type=radio name=%s value=1 %s> %s (%s)\n",
 168                         $o->[0], $mode == 1 ? "checked" : "", $text{'default'},
 169                         $o->[1] ? $text{'mppe_d1'} : $text{'mppe_d0'};
 170                 printf "<input type=radio name=%s value=0 %s> %s\n",
 171                         $o->[0], $mode == 0 ? "checked" : "", $text{'mppe_m0'};
 172                 print "</td> </tr>\n";
 173                 }
 174         local @anyold = grep { &find($_, $opts) } @old_mppe;
 175         if (@anyold) {
 176                 print "<tr> <td colspan=4 align=center>",&text('mppe_old',
 177                         "<tt>".join(" ", @anyold)."</tt>"),"</td> </tr>\n";
 178                 }
 179         }
 180 else {
 181         # Show old MPPE options
 182         $i = 0;
 183         foreach $o (@old_mppe) {
 184                 print "<tr>\n" if ($i%2 == 0);
 185                 local $v = &find($o, $opts);
 186                 print "<td><b>",$text{'mppe_'.$o},"</b></td> <td>\n";
 187                 printf "<input type=radio name=$o value=1 %s> %s\n",
 188                         $v ? "checked" : "", $text{'yes'};
 189                 printf "<input type=radio name=$o value=0 %s> %s</td>\n",
 190                         $v ? "" : "checked", $text{'no'};
 191                 print "</tr>\n" if ($i%2 == 1);
 192                 $i++;
 193                 }
 194         local @anynew = grep { &find($_, $opts) }
 195                 ( map { 'require-'.$_->[0] } @new_mppe ),
 196                 ( map { 'no'.$_->[0] } @new_mppe );
 197         if (@anynew) {
 198                 print "<tr> <td colspan=4 align=center>",&text('mppe_new',
 199                         "<tt>".join(" ", @anynew)."</tt>"),"</td> </tr>\n";
 200                 }
 201         print "</tr>\n";
 202         }
 203 }
 204
 205 # parse_mppe_options(&config, file)
 206 sub parse_mppe_options
 207 {
 208 local $o;
 209 if ($in{'mppe_mode'}) {
 210         # Parse new-style options
 211         foreach $o (map { $_->[0] } @new_mppe) {
 212                 if ($in{$o} == 2) {
 213                         &save_ppp_option($_[0], $_[1], "require-$o",
 214                                          { 'name' => "require-$o" });
 215                         &save_ppp_option($_[0], $_[1], "no$o", undef);
 216                         }
 217                 elsif ($in{$o} == 1) {
 218                         &save_ppp_option($_[0], $_[1], "require-$o", undef);
 219                         &save_ppp_option($_[0], $_[1], "no$o", undef);
 220                         }
 221                 else {
 222                         &save_ppp_option($_[0], $_[1], "require-$o", undef);
 223                         &save_ppp_option($_[0], $_[1], "no$o",
 224                                          { 'name' => "no$o" });
 225                         }
 226                 }
 227         }
 228 else {
 229         # Parse old-style options
 230         foreach $o (@old_mppe) {
 231                 &save_ppp_option($_[0], $_[1], $o,
 232                                  $in{$o} ? { 'name' => $o } : undef);
 233                 }
 234         }
 235 }
 236
 237 # mppe_support()
 238 # Returns 1 if the PPP daemon supports new-style MPPE options (version 2.4.2+,
 239 # 0 if might only support the old options)
 240 sub mppe_support
 241 {
 242 local $out = `pppd --help 2>&1`;
 243 local $vers;
 244 if ($out =~ /version\s+(\S+)/i) {
 245         $vers = $1;
 246         }
 247 if ($vers =~ /^(\d+)/ && $1 > 2 ||
 248     $vers =~ /^(\d+)\.(\d+)/ && $1 == 2 && $2 > 4 ||
 249     $vers =~ /^(\d+)\.(\d+)\.(\d+)/ && $1 == 2 && $2 == 4 && $3 >= 2) {
 250         return 1;
 251         }
 252 return 0;
 253 }
 254
 255 # get_pppd_version(&out)
 256 sub get_pppd_version
 257 {
 258 local $out = `pppd --help 2>&1`;
 259 ${$_[0]} = $out;
 260 return $out =~ /version\s+(\S+)/i ? $1 : undef;
 261 }
 262
 263 # connect_tunnel(&tunnel)
 264 # Attempts to open some tunnel. Returns either :
 265 # 1, iface-name, iface-address, iface-ptp
 266 # 0, error-message
 267 sub connect_tunnel
 268 {
 269 local $tunnel = $_[0];
 270 &foreign_require("net", "net-lib.pl");
 271
 272 # Run the PPTP command, and wait for a new pppN interface to come up
 273 local %sifaces = map { $_->{'fullname'}, $_->{'address'} } &get_ppp_ifaces();
 274 local $start = time();
 275 local $temp = &tempname();
 276 &system_logged("modprobe ip_gre >/dev/null 2>&1");
 277 &system_logged("$config{'pptp'} ".quotemeta($tunnel->{'server'})." call ".
 278                quotemeta($tunnel->{'name'})." >$temp 2>&1 </dev/null &");
 279 local $newiface;
 280 LOOP: while(time() - $start < $config{'timeout'}) {
 281         sleep(1);
 282         local @nifaces = &get_ppp_ifaces();
 283         local $i;
 284         foreach $i (@nifaces) {
 285                 if (!$sifaces{$i->{'fullname'}}) {
 286                         $newiface = $i;
 287                         last LOOP;
 288                         }
 289                 }
 290         }
 291 local $tempout = `cat $temp`;
 292 unlink($temp);
 293
 294 # Find out if we were connected, or if it failed
 295 if ($newiface) {
 296         # It worked! Add the routes
 297         local (@rout, @rcmd);
 298         if (@{$tunnel->{'routes'}}) {
 299                 local @routes = &net::list_routes();
 300                 local ($defroute) = grep { $_->{'dest'} eq '0.0.0.0' } @routes;
 301                 local $oldgw = $defroute->{'gateway'} if ($defroute);
 302                 foreach $r (@{$tunnel->{'routes'}}) {
 303                         $cmd = "route $r";
 304                         $cmd =~ s/TUNNEL_DEV/$newiface->{'fullname'}/g;
 305                         $cmd =~ s/DEF_GW/$oldgw/g;
 306                         $cmd =~ s/GW/$newiface->{'ptp'}/g;
 307                         push(@rcmd, $cmd);
 308                         $out = &backquote_logged("$cmd 2>&1 </dev/null");
 309                         push(@rout, $out);
 310                         }
 311                 }
 312
 313         return (1, $newiface->{'fullname'}, $newiface->{'address'},
 314                    $newiface->{'ptp'}, \@rcmd, \@rout);
 315         }
 316 else {
 317         # Must have timed out due to a failure
 318         &foreign_require("syslog", "syslog-lib.pl");
 319         local $sysconf = &syslog::get_config();
 320         local $c;
 321         local $logs;
 322         foreach $c (@$sysconf) {
 323                 next if ($c->{'tag'} || !$c->{'file'} || !-f $c->{'file'});
 324                 local @st = stat($c->{'file'});
 325                 if ($st[9] > $start) {
 326                         # Was modified since start .. but by ppp or pptp?
 327                         local $tail = `tail -10 '$c->{'file'}'`;
 328                         if ($tail =~ /ppp|pptp/) {
 329                                 $logs = $tail;
 330                                 last;
 331                                 }
 332                         }
 333                 }
 334         return (0, $tempout.$logs || "No logged error messages found");
 335         }
 336 }
 337
 338 sub get_ppp_ifaces
 339 {
 340 return grep { $_->{'fullname'} =~ /^ppp(\d+)$/ &&
 341               $_->{'up'} && $_->{'address'} } &net::active_interfaces();
 342 }
 343
 344
 345 1;
 346